Released XU*8*767 SEQ #610 Extracted from mail message **KIDS**:XU*8.0*767^ **INSTALL NAME** XU*8.0*767 "BLD",3769,0) XU*8.0*767^KERNEL^0^3220214^y "BLD",3769,1,0) ^^3^3^3220214^ "BLD",3769,1,1,0) KERNEL VISTA ENHANCEMENT - PPMS/PIE UPDATE "BLD",3769,1,2,0) Refer to patch XU*8.0*767 in the FORUM Patch Module for a complete "BLD",3769,1,3,0) description. "BLD",3769,4,0) ^9.64PA^^ "BLD",3769,6) 1 "BLD",3769,6.3) 1 "BLD",3769,"KRN",0) ^9.67PA^1.5^25 "BLD",3769,"KRN",.4,0) .4 "BLD",3769,"KRN",.401,0) .401 "BLD",3769,"KRN",.402,0) .402 "BLD",3769,"KRN",.403,0) .403 "BLD",3769,"KRN",.5,0) .5 "BLD",3769,"KRN",.84,0) .84 "BLD",3769,"KRN",1.5,0) 1.5 "BLD",3769,"KRN",1.6,0) 1.6 "BLD",3769,"KRN",1.61,0) 1.61 "BLD",3769,"KRN",1.62,0) 1.62 "BLD",3769,"KRN",3.6,0) 3.6 "BLD",3769,"KRN",3.8,0) 3.8 "BLD",3769,"KRN",9.2,0) 9.2 "BLD",3769,"KRN",9.8,0) 9.8 "BLD",3769,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",3769,"KRN",9.8,"NM",1,0) XUMVIENU^^0^B212519191 "BLD",3769,"KRN",9.8,"NM","B","XUMVIENU",1) "BLD",3769,"KRN",19,0) 19 "BLD",3769,"KRN",19.1,0) 19.1 "BLD",3769,"KRN",101,0) 101 "BLD",3769,"KRN",409.61,0) 409.61 "BLD",3769,"KRN",771,0) 771 "BLD",3769,"KRN",779.2,0) 779.2 "BLD",3769,"KRN",870,0) 870 "BLD",3769,"KRN",8989.51,0) 8989.51 "BLD",3769,"KRN",8989.52,0) 8989.52 "BLD",3769,"KRN",8993,0) 8993 "BLD",3769,"KRN",8994,0) 8994 "BLD",3769,"KRN","B",.4,.4) "BLD",3769,"KRN","B",.401,.401) "BLD",3769,"KRN","B",.402,.402) "BLD",3769,"KRN","B",.403,.403) "BLD",3769,"KRN","B",.5,.5) "BLD",3769,"KRN","B",.84,.84) "BLD",3769,"KRN","B",1.5,1.5) "BLD",3769,"KRN","B",1.6,1.6) "BLD",3769,"KRN","B",1.61,1.61) "BLD",3769,"KRN","B",1.62,1.62) "BLD",3769,"KRN","B",3.6,3.6) "BLD",3769,"KRN","B",3.8,3.8) "BLD",3769,"KRN","B",9.2,9.2) "BLD",3769,"KRN","B",9.8,9.8) "BLD",3769,"KRN","B",19,19) "BLD",3769,"KRN","B",19.1,19.1) "BLD",3769,"KRN","B",101,101) "BLD",3769,"KRN","B",409.61,409.61) "BLD",3769,"KRN","B",771,771) "BLD",3769,"KRN","B",779.2,779.2) "BLD",3769,"KRN","B",870,870) "BLD",3769,"KRN","B",8989.51,8989.51) "BLD",3769,"KRN","B",8989.52,8989.52) "BLD",3769,"KRN","B",8993,8993) "BLD",3769,"KRN","B",8994,8994) "BLD",3769,"QDEF") ^^^^NO^^^^NO^^NO "BLD",3769,"QUES",0) ^9.62^^ "BLD",3769,"REQB",0) ^9.611^1^1 "BLD",3769,"REQB",1,0) XU*8.0*744^2 "BLD",3769,"REQB","B","XU*8.0*744",1) "MBREQ") 0 "PKG",138,-1) 1^1 "PKG",138,0) KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^ "PKG",138,22,0) ^9.49I^1^1 "PKG",138,22,1,0) 8.0^2950703^2951127^12541 "PKG",138,22,1,"PAH",1,0) 767^3220214 "PKG",138,22,1,"PAH",1,1,0) ^^3^3^3220214 "PKG",138,22,1,"PAH",1,1,1,0) KERNEL VISTA ENHANCEMENT - PPMS/PIE UPDATE "PKG",138,22,1,"PAH",1,1,2,0) Refer to patch XU*8.0*767 in the FORUM Patch Module for a complete "PKG",138,22,1,"PAH",1,1,3,0) description. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","XUMVIENU") 0^1^B212519191^B211406256 "RTN","XUMVIENU",1,0) XUMVIENU ;MVI/CKN,MKO - Master Veteran Index Enrich New Person ; 1/26/21 3:10pm "RTN","XUMVIENU",2,0) ;;8.0;KERNEL;**711,724,744,767**;Jul 10, 1995;Build 1 "RTN","XUMVIENU",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","XUMVIENU",4,0) ;**711,Story 977838 (mko/ckn): New routine "RTN","XUMVIENU",5,0) ;Entry point: UPDATE^XUMVIENU(XURET,.XUARR,XUFLAG) "RTN","XUMVIENU",6,0) ; called from rpc: XUS MVI ENRICH NEW PERSON "RTN","XUMVIENU",7,0) ; "RTN","XUMVIENU",8,0) ; Input: "RTN","XUMVIENU",9,0) ; XUARR(subscript)=value to update "RTN","XUMVIENU",10,0) ; XUFLAG = "A" : if RPC is being called to add a record to the New Person file "RTN","XUMVIENU",11,0) ; "U" : if RPC is being called to edit an existing New Person file record. "RTN","XUMVIENU",12,0) ; "RTN","XUMVIENU",13,0) ; Return Parameter: "RTN","XUMVIENU",14,0) ; On success: "RTN","XUMVIENU",15,0) ; DUZ of New Person File entry edited or added "RTN","XUMVIENU",16,0) ; Returned if there were no issues adding or editing the entry. "RTN","XUMVIENU",17,0) ; "RTN","XUMVIENU",18,0) ; DUZ^-1^errorMessage "RTN","XUMVIENU",19,0) ; Returned if entry was edited, but some data was not valid and could "RTN","XUMVIENU",20,0) ; not be filed. "RTN","XUMVIENU",21,0) ; On failure: "RTN","XUMVIENU",22,0) ; -1^errorMessage "RTN","XUMVIENU",23,0) ; Returned for example if required data was not passed, entry could "RTN","XUMVIENU",24,0) ; not be added when FLAG="A", or entry could not be found based on "RTN","XUMVIENU",25,0) ; the NPI when FLAG="U". "RTN","XUMVIENU",26,0) ; "RTN","XUMVIENU",27,0) UPDATE(XURET,XUARR,XUFLAG) ;RPC to enrich New Pperson file entry "RTN","XUMVIENU",28,0) N XUDBSEQ "RTN","XUMVIENU",29,0) S XUDBSEQ=$$RECORD(.XUARR,$G(XUFLAG)) "RTN","XUMVIENU",30,0) D PROC(.XURET,.XUARR,.XUFLAG) "RTN","XUMVIENU",31,0) D RETURN(XUDBSEQ,XURET) "RTN","XUMVIENU",32,0) Q "RTN","XUMVIENU",33,0) ; "RTN","XUMVIENU",34,0) PROC(XURET,XUARR,XUFLAG) ;Main code for RPC "RTN","XUMVIENU",35,0) N FDA,OLDTDATE,XUDUZ,XURSET "RTN","XUMVIENU",36,0) K XURET S XURSET=0 "RTN","XUMVIENU",37,0) ; "RTN","XUMVIENU",38,0) ;Check inputs "RTN","XUMVIENU",39,0) S XURET=$$CHKINPUT(.XUARR,.XUFLAG) "RTN","XUMVIENU",40,0) Q:XURET<0 "RTN","XUMVIENU",41,0) ; "RTN","XUMVIENU",42,0) ;Add or get New Person IEN in XUDUZ "RTN","XUMVIENU",43,0) S XURET="" "RTN","XUMVIENU",44,0) I $G(XUFLAG)="A" D "RTN","XUMVIENU",45,0) . ;Call entry point to add the record "RTN","XUMVIENU",46,0) . D:$G(XUARR("SubjectOrgan"))=""!($G(XUARR("SubjectOrganID"))="") SUBJDEF(.XUARR) "RTN","XUMVIENU",47,0) . S XUDUZ=$$ADDUSER^XUMVINPA(.XUARR) "RTN","XUMVIENU",48,0) . I $P(XUDUZ,"^",3)'=1 S XUFLAG="U",XURSET=1 ;**767 found exists already so process as update "RTN","XUMVIENU",49,0) . I XUDUZ<0 S XURET=XUDUZ ;If error, we'll return -1^errorMessage "RTN","XUMVIENU",50,0) . E I $P(XUDUZ,U,3)=1 S XUDUZ=+XUDUZ ;If record was added, set XUDUZ to new IEN "RTN","XUMVIENU",51,0) . E S XURET=+XUDUZ ;If record was found, not added, we'll just return DUZ -- no edit will take place "RTN","XUMVIENU",52,0) E D "RTN","XUMVIENU",53,0) . ;Lookup user based on NPI "RTN","XUMVIENU",54,0) . ;S XATTRIB(8)=XUARR("NPI") ; NPI "RTN","XUMVIENU",55,0) . ;S XUDUZ=$$FINDUSER^XUESSO2(.XATTRIB) ; find user based on NPI ; returns -1^Not authorized if DUZ("LOA")<2 "RTN","XUMVIENU",56,0) . S XUDUZ=$O(^VA(200,"ANPI",XUARR("NPI"),0)) "RTN","XUMVIENU",57,0) . S:XUDUZ'>0 XURET="-1^User with NPI "_XUARR("NPI")_" not found." "RTN","XUMVIENU",58,0) ; "RTN","XUMVIENU",59,0) ;If add or lookup above set XURET, we're done "RTN","XUMVIENU",60,0) I XURET]""&(XUFLAG="A") Q "RTN","XUMVIENU",61,0) ; "RTN","XUMVIENU",62,0) ;**744 - VAMPI-8213 (ckn) "RTN","XUMVIENU",63,0) ;If update is from PPMS/PIE and if New Person have Primary Menu, "RTN","XUMVIENU",64,0) ;then no update as this is a Dual Provider. "RTN","XUMVIENU",65,0) I $G(XUFLAG)="U",($G(XUARR("WHO"))="200PIEV"),($P($G(^VA(200,+XUDUZ,201)),"^")'="") S XURET="-1^Provider has a Primary Menu, no update." Q ;**744 - VAMPI-8213 (ckn) "RTN","XUMVIENU",66,0) ;If update is from PPMS/PIE and if CPRS TAB multiple field have any other "RTN","XUMVIENU",67,0) ;values than "NVA", then no update as this is a Dual Provider. "RTN","XUMVIENU",68,0) N QCPFLG,TABIEN S QCPFLG=0 "RTN","XUMVIENU",69,0) I $G(XUFLAG)="U",($G(XUARR("WHO"))="200PIEV") D "RTN","XUMVIENU",70,0) .N ORDIEN S ORDIEN=$O(^ORD(101.13,"B","NVA","")) "RTN","XUMVIENU",71,0) .I $D(^VA(200,+XUDUZ,"ORD")) D "RTN","XUMVIENU",72,0) ..S TABIEN=0 F S TABIEN=$O(^VA(200,+XUDUZ,"ORD","B",TABIEN)) Q:+TABIEN=0!(QCPFLG) D "RTN","XUMVIENU",73,0) ...I TABIEN'=ORDIEN S QCPFLG=1 "RTN","XUMVIENU",74,0) I QCPFLG S XURET="-1^Provider has Non-NVA values in CPRS TAB" Q "RTN","XUMVIENU",75,0) ; "RTN","XUMVIENU",76,0) ;Update the NAME first. (Within a FILE^DIE call, triggers on the .01 that in turn call FILE^DIE "RTN","XUMVIENU",77,0) ;may cause the Filer flag to change from "E", to "".) "RTN","XUMVIENU",78,0) I $G(XUFLAG)'="A",$D(XUARR("NAME"))#2 D "RTN","XUMVIENU",79,0) . N NAME "RTN","XUMVIENU",80,0) . S NAME=$P($G(XUARR("NAME")),"|",5) "RTN","XUMVIENU",81,0) . S:NAME="" NAME=$$FMNAME^HLFNC($G(XUARR("NAME")),"|") "RTN","XUMVIENU",82,0) . I NAME]"" S FDA(200,+XUDUZ_",",.01)=NAME D FILER(.FDA,"E",.XURET) "RTN","XUMVIENU",83,0) ; "RTN","XUMVIENU",84,0) ;Set up FDA "RTN","XUMVIENU",85,0) D SETFDA(XUDUZ,.XUARR,.FDA) "RTN","XUMVIENU",86,0) ; "RTN","XUMVIENU",87,0) ;Remove Termination Date from FDA if it's in the future "RTN","XUMVIENU",88,0) D TERMDATE(.FDA,.XURES) "RTN","XUMVIENU",89,0) ; "RTN","XUMVIENU",90,0) ;Save the original Termination Date "RTN","XUMVIENU",91,0) S OLDTDATE=$P($G(^VA(200,XUDUZ,0)),U,11) "RTN","XUMVIENU",92,0) ; "RTN","XUMVIENU",93,0) ;Call the Filer "RTN","XUMVIENU",94,0) D FILER(.FDA,"E",.XURET) "RTN","XUMVIENU",95,0) ; "RTN","XUMVIENU",96,0) ;**744 - VAMPI-3039 (ckn) - Update CPRS tab "RTN","XUMVIENU",97,0) I $G(XUARR("WHO"))="200PIEV" D CPRSNVA^XUMVIEU1(XUDUZ,.XUARR,OLDTDATE) "RTN","XUMVIENU",98,0) ; "RTN","XUMVIENU",99,0) ;If Termination Date was added or deleted, remove or add Security keys PROVIDER and XUORES "RTN","XUMVIENU",100,0) D SECKEYS(XUDUZ,OLDTDATE,.XURET,XURSET) ;**767 OR if ADD is now UPDATE XURSET=1 "RTN","XUMVIENU",101,0) ; "RTN","XUMVIENU",102,0) ;File the Person Class data "RTN","XUMVIENU",103,0) D PERSCLAS(XUDUZ,.XUARR,.XURET) "RTN","XUMVIENU",104,0) ; "RTN","XUMVIENU",105,0) ;File the DEA data "RTN","XUMVIENU",106,0) I $$PATCH^XPDUTL("XU*8.0*688"),$$VFIELD^DILFD(200,53.21),$$VFILE^DILFD(8991.9) D "RTN","XUMVIENU",107,0) . ;File NEW DEA #'S in multiple and add/edit entries in File #8991.9 "RTN","XUMVIENU",108,0) . D NEWDEA(XUDUZ,.XUARR,.XURET) "RTN","XUMVIENU",109,0) . ;File first NEW DEA data into single-valued fields of NP file "RTN","XUMVIENU",110,0) . D NPDEA(XUDUZ,.XUARR,.XURET) "RTN","XUMVIENU",111,0) E D "RTN","XUMVIENU",112,0) . ;File first valid DEA # into file (NEW DEA#'s multiple doesn't exist) "RTN","XUMVIENU",113,0) . D FIRSTDEA(XUDUZ,.XUARR,.XURET) "RTN","XUMVIENU",114,0) ; "RTN","XUMVIENU",115,0) ;Return DUZ in first piece. If errors, also return -1^errMsg in 2nd and 3rd pieces. "RTN","XUMVIENU",116,0) S XURET=XUDUZ_$S(XURET<0:U_XURET,1:"") "RTN","XUMVIENU",117,0) Q "RTN","XUMVIENU",118,0) ; "RTN","XUMVIENU",119,0) CHKINPUT(XUARR,XUFLAG) ;Check inputs "RTN","XUMVIENU",120,0) ;Returns: "-1^errorMsg" if problem; otherwise return 0 "RTN","XUMVIENU",121,0) Q:'$D(XUARR) "-1^No data passed" "RTN","XUMVIENU",122,0) Q:$G(XUARR("NPI"))="" "-1^Missing NPI" "RTN","XUMVIENU",123,0) Q:'$$CHKDGT^XUSNPI($G(XUARR("NPI"))) "-1^NPI is not valid" "RTN","XUMVIENU",124,0) Q:$G(XUARR("WHO"))="" "-1^Missing requesting Station number" "RTN","XUMVIENU",125,0) ; "RTN","XUMVIENU",126,0) S:$G(XUFLAG)="" XUFLAG="U" "RTN","XUMVIENU",127,0) Q:"^A^U^"'[(U_$G(XUFLAG)_U) "-1^Invalid flag "_XUFLAG_" was passed." "RTN","XUMVIENU",128,0) Q 0 "RTN","XUMVIENU",129,0) ; "RTN","XUMVIENU",130,0) SETFDA(IEN,XUARR,FDA) ;Set FDA from XUARR for filing into File #200 "RTN","XUMVIENU",131,0) ;**744 VAMPI-3039 (ckn) - Moving this tag to new routine XUMVIEU1 "RTN","XUMVIENU",132,0) D SETFDA^XUMVIEU1(IEN,.XUARR,.FDA) "RTN","XUMVIENU",133,0) Q "RTN","XUMVIENU",134,0) ; "RTN","XUMVIENU",135,0) SUBJDEF(XUARR) ;Set default Subject Organization and ID "RTN","XUMVIENU",136,0) S XUARR("SubjectOrgan")="Department Of Veterans Affairs" "RTN","XUMVIENU",137,0) S XUARR("SubjectOrganID")="urn:oid:2.16.840.1.113883.4.349" "RTN","XUMVIENU",138,0) Q "RTN","XUMVIENU",139,0) ; "RTN","XUMVIENU",140,0) TERMDATE(FDA,XURES) ;Remove Termination Date from FDA if it's in the future, "RTN","XUMVIENU",141,0) ;or if Termination Date is passed but user has a Primary Menu, and return an error message "RTN","XUMVIENU",142,0) N IENS,TDATE "RTN","XUMVIENU",143,0) S IENS=$O(FDA(200,"")) Q:IENS="" "RTN","XUMVIENU",144,0) Q:"@"[$G(FDA(200,IENS,9.2)) "RTN","XUMVIENU",145,0) ; "RTN","XUMVIENU",146,0) ;Get internal form "RTN","XUMVIENU",147,0) S TDATE=$$GETINT(200,9.2,FDA(200,IENS,9.2)) Q:TDATE=U "RTN","XUMVIENU",148,0) ; "RTN","XUMVIENU",149,0) I $P($G(^VA(200,+IENS,201)),U)]"" D Q "RTN","XUMVIENU",150,0) . D ADDERR(.XURET,"User has a PRIMARY MENU and cannot be terminated.") "RTN","XUMVIENU",151,0) . K FDA(200,IENS,9.2) "RTN","XUMVIENU",152,0) ; "RTN","XUMVIENU",153,0) ;Remove from FDA if it's a future date, and add an error message "RTN","XUMVIENU",154,0) D:TDATE>DT "RTN","XUMVIENU",155,0) . D ADDERR(.XURET,"TERMINATION DATE '"_FDA(200,IENS,9.2)_"' is in the future.") "RTN","XUMVIENU",156,0) . K FDA(200,IENS,9.2) "RTN","XUMVIENU",157,0) Q "RTN","XUMVIENU",158,0) ; "RTN","XUMVIENU",159,0) SECKEYS(XUDUZ,OLDTDATE,XURET,XURSET) ;Add or remove Security Keys PROVIDER and XUORES "RTN","XUMVIENU",160,0) ;based on whether Termination Date is deleted or created "RTN","XUMVIENU",161,0) ;**767 OR if ADD is now UPDATE XURSET=1 "RTN","XUMVIENU",162,0) N KEY,KEYIEN,NEWTDATE "RTN","XUMVIENU",163,0) S XUDUZ=+$G(XUDUZ),OLDTDATE=$G(OLDTDATE) "RTN","XUMVIENU",164,0) S NEWTDATE=$P($G(^VA(200,XUDUZ,0)),U,11) "RTN","XUMVIENU",165,0) Q:$G(OLDTDATE)=NEWTDATE&(XURSET=0) "RTN","XUMVIENU",166,0) ; "RTN","XUMVIENU",167,0) F KEY="PROVIDER","XUORES" D "RTN","XUMVIENU",168,0) . S KEYIEN=$O(^DIC(19.1,"B",KEY,0)) Q:KEYIEN'>0 "RTN","XUMVIENU",169,0) . I OLDTDATE="",NEWTDATE]"" D "RTN","XUMVIENU",170,0) .. ;Delete the key "RTN","XUMVIENU",171,0) .. N DA,DIK "RTN","XUMVIENU",172,0) .. S DA=$O(^VA(200,XUDUZ,51,"B",KEYIEN,0)) Q:DA'>0 "RTN","XUMVIENU",173,0) .. S DA(1)=XUDUZ,DIK="^VA(200,"_XUDUZ_",51," "RTN","XUMVIENU",174,0) .. D ^DIK "RTN","XUMVIENU",175,0) .I OLDTDATE]"",NEWTDATE="" D ADDKEY(XUDUZ,KEYIEN) "RTN","XUMVIENU",176,0) .I XURSET=1 D ADDKEY(XUDUZ,KEYIEN) "RTN","XUMVIENU",177,0) Q "RTN","XUMVIENU",178,0) ADDKEY(XUDUZ,KEYIEN) ;Add the key "RTN","XUMVIENU",179,0) ;**724,Story 1209890 (mko): The #.01 of the KEYS multiple is DINUM'd, so pass IEN(1) "RTN","XUMVIENU",180,0) ; Also, GIVEN BY (#1) and DATE GIVEN (#2) are triggered by the #.01. "RTN","XUMVIENU",181,0) N IENS,FDA,IEN "RTN","XUMVIENU",182,0) Q:$O(^VA(200,XUDUZ,51,"B",KEYIEN,0)) "RTN","XUMVIENU",183,0) S IENS="+1,"_XUDUZ_"," "RTN","XUMVIENU",184,0) S (FDA(200.051,IENS,.01),IEN(1))=KEYIEN "RTN","XUMVIENU",185,0) D UPDATER(.FDA,"",.XURET,.IEN) "RTN","XUMVIENU",186,0) Q "RTN","XUMVIENU",187,0) ; "RTN","XUMVIENU",188,0) PERSCLAS(XUDUZ,XUARR,XURET) ;Update PERSON CLASS multiple "RTN","XUMVIENU",189,0) N CNT,CURVAL,D0,FDA,IEN,IENS,NEWVAL,PCIEN,VACODE,X12CODE "RTN","XUMVIENU",190,0) S CNT=0 F S CNT=$O(XUARR("PersonClass",CNT)) Q:'CNT D "RTN","XUMVIENU",191,0) . S X12CODE=$G(XUARR("PersonClass",CNT,"PersonClass")) Q:X12CODE="" "RTN","XUMVIENU",192,0) . ; "RTN","XUMVIENU",193,0) . ;Lookup the Person Class entry in the multiple "RTN","XUMVIENU",194,0) . S PCIEN=0 "RTN","XUMVIENU",195,0) . S VACODE=$S(X12CODE="207LP3000X":"V110403",X12CODE="2084B0040X":"V182914",X12CODE="390200000X":"V115500",1:"") I VACODE'="" S PCIEN=$O(^USC(8932.1,"F",VACODE,0)) ;to resolve duplicate x12 codes "RTN","XUMVIENU",196,0) . I 'PCIEN S PCIEN=$O(^USC(8932.1,"G",X12CODE,0)) "RTN","XUMVIENU",197,0) . S IEN=$O(^VA(200,+XUDUZ,"USC1","B",+PCIEN,0)) "RTN","XUMVIENU",198,0) . ; "RTN","XUMVIENU",199,0) . ;If not found, add it "RTN","XUMVIENU",200,0) . I IEN'>0 D Q:IEN'>0 "RTN","XUMVIENU",201,0) .. S FDA(200.05,"+1,"_+XUDUZ_",",.01)=PCIEN ;now passing internal value of X12CODE "RTN","XUMVIENU",202,0) .. S IEN=$$UPDATER(.FDA,"",.XURET) "RTN","XUMVIENU",203,0) . ; "RTN","XUMVIENU",204,0) . ;Update the other values in the Person Class multiple "RTN","XUMVIENU",205,0) . S IENS=+IEN_","_+XUDUZ_"," "RTN","XUMVIENU",206,0) . S CURVAL=$P($G(^VA(200,+XUDUZ,"USC1",+IEN,0)),U,2) "RTN","XUMVIENU",207,0) . S NEWVAL=$G(XUARR("PersonClass",CNT,"PersonClassActive")) "RTN","XUMVIENU",208,0) . I NEWVAL="",'$$ISPCACTV(XUDUZ,IEN) S FDA(200.05,IENS,2)="TODAY",FDA(200.05,IENS,3)="@" "RTN","XUMVIENU",209,0) . E I NEWVAL]"" S FDA(200.05,IENS,2)=NEWVAL "RTN","XUMVIENU",210,0) . S:$D(XUARR("PersonClass",CNT,"PersonClassExpire"))#2 FDA(200.05,IENS,3)=XUARR("PersonClass",CNT,"PersonClassExpire") "RTN","XUMVIENU",211,0) . S D0=+XUDUZ ;Needed by input transform of Effective Date (200.05,2) "RTN","XUMVIENU",212,0) . D FILER(.FDA,"E",.XURET) "RTN","XUMVIENU",213,0) Q "RTN","XUMVIENU",214,0) ; "RTN","XUMVIENU",215,0) ISPCACTV(XUDUZ,SUBIEN) ;Is the Person Class active? "RTN","XUMVIENU",216,0) N EFFDT,EXPDT,ND "RTN","XUMVIENU",217,0) S ND=$G(^VA(200,+$G(XUDUZ),"USC1",+$G(SUBIEN),0)) Q:ND="" 0 "RTN","XUMVIENU",218,0) S EFFDT=$P(ND,U,2),EXPDT=$P(ND,U,3) "RTN","XUMVIENU",219,0) I EFFDT,DT'EXPDT Q 1 "RTN","XUMVIENU",220,0) Q 0 "RTN","XUMVIENU",221,0) ; "RTN","XUMVIENU",222,0) NEWDEA(XUDUZ,XUARR,XURET) ;Update DEA NUMBERS File #8991.9 "RTN","XUMVIENU",223,0) ;and the NEW PERSON File NEW DEA #'s multiple "RTN","XUMVIENU",224,0) N CNT,DEA,DIERR,DIHELP,DIMSG,FDA,IEN,IENS,NDEAIEN,XUERR "RTN","XUMVIENU",225,0) N STR1,STR2,STR3,CITY,STATE,ZIP,ADDR "RTN","XUMVIENU",226,0) ; "RTN","XUMVIENU",227,0) ;Get address parts "RTN","XUMVIENU",228,0) D:$D(XUARR("ADDRESS DATA"))#2 "RTN","XUMVIENU",229,0) . S ADDR=XUARR("ADDRESS DATA") "RTN","XUMVIENU",230,0) . S STR1=$E($P(ADDR,"|"),1,$$MAXLEN(8991.9,1.2)) "RTN","XUMVIENU",231,0) . S STR2=$E($P(ADDR,"|",2),1,$$MAXLEN(8991.9,1.3)) "RTN","XUMVIENU",232,0) . S STR3=$E($P(ADDR,"|",3),1,$$MAXLEN(8991.9,1.4)) "RTN","XUMVIENU",233,0) . S CITY=$E($P(ADDR,"|",4),1,$$MAXLEN(8991.9,1.5)) "RTN","XUMVIENU",234,0) . S STATE=$P(ADDR,"|",5) "RTN","XUMVIENU",235,0) . S ZIP=$TR($P(ADDR,"|",6),"-") "RTN","XUMVIENU",236,0) ; "RTN","XUMVIENU",237,0) S CNT=0 F S CNT=$O(XUARR("DEA",CNT)) Q:'CNT D "RTN","XUMVIENU",238,0) . S DEA=$G(XUARR("DEA",CNT,"DEA")) "RTN","XUMVIENU",239,0) . Q:DEA="" "RTN","XUMVIENU",240,0) . ; "RTN","XUMVIENU",241,0) . ;Lookup or add a record to File #8991.9 with the passed DEA # "RTN","XUMVIENU",242,0) . S NDEAIEN=$O(^XTV(8991.9,"B",DEA,0)) "RTN","XUMVIENU",243,0) . I NDEAIEN'>0 D Q:NDEAIEN'>0 "RTN","XUMVIENU",244,0) .. K FDA "RTN","XUMVIENU",245,0) .. S IENS="+1," "RTN","XUMVIENU",246,0) .. S FDA(8991.9,IENS,.01)=DEA "RTN","XUMVIENU",247,0) .. S FDA(8991.9,IENS,10.2)="NOW" "RTN","XUMVIENU",248,0) .. S NDEAIEN=$$UPDATER(.FDA,"E",.XURET) "RTN","XUMVIENU",249,0) . ; "RTN","XUMVIENU",250,0) . ;Update Expiration Date, Address, and Schedule fields for this File #8991.9 entry "RTN","XUMVIENU",251,0) . K FDA "RTN","XUMVIENU",252,0) . S IENS=NDEAIEN_"," "RTN","XUMVIENU",253,0) . D:$D(XUARR("ADDRESS DATA"))#2 "RTN","XUMVIENU",254,0) .. S FDA(8991.9,IENS,1.2)=STR1 "RTN","XUMVIENU",255,0) .. S FDA(8991.9,IENS,1.3)=STR2 "RTN","XUMVIENU",256,0) .. S FDA(8991.9,IENS,1.4)=STR3 "RTN","XUMVIENU",257,0) .. S FDA(8991.9,IENS,1.5)=CITY "RTN","XUMVIENU",258,0) .. S FDA(8991.9,IENS,1.6)=$$STATEIEN(STATE) "RTN","XUMVIENU",259,0) .. S FDA(8991.9,IENS,1.7)=ZIP "RTN","XUMVIENU",260,0) . S:$D(XUARR("DEA",CNT,"Detox"))#2 FDA(8991.9,IENS,.03)=XUARR("DEA",CNT,"Detox") "RTN","XUMVIENU",261,0) . S:$D(XUARR("DEA",CNT,"DEAExpire"))#2 FDA(8991.9,IENS,.04)=XUARR("DEA",CNT,"DEAExpire") "RTN","XUMVIENU",262,0) . S:$D(XUARR("DEA",CNT,"SchedIINarc"))#2 FDA(8991.9,IENS,2.1)=XUARR("DEA",CNT,"SchedIINarc") "RTN","XUMVIENU",263,0) . S:$D(XUARR("DEA",CNT,"SchedIINonNarc"))#2 FDA(8991.9,IENS,2.2)=XUARR("DEA",CNT,"SchedIINonNarc") "RTN","XUMVIENU",264,0) . S:$D(XUARR("DEA",CNT,"SchedIIINarc"))#2 FDA(8991.9,IENS,2.3)=XUARR("DEA",CNT,"SchedIIINarc") "RTN","XUMVIENU",265,0) . S:$D(XUARR("DEA",CNT,"SchedIIINonNarc"))#2 FDA(8991.9,IENS,2.4)=XUARR("DEA",CNT,"SchedIIINonNarc") "RTN","XUMVIENU",266,0) . S:$D(XUARR("DEA",CNT,"SchedIV"))#2 FDA(8991.9,IENS,2.5)=XUARR("DEA",CNT,"SchedIV") "RTN","XUMVIENU",267,0) . S:$D(XUARR("DEA",CNT,"SchedV"))#2 FDA(8991.9,IENS,2.6)=XUARR("DEA",CNT,"SchedV") "RTN","XUMVIENU",268,0) . S:$D(FDA) FDA(8991.9,IENS,10.1)=$S($G(DUZ):"`"_DUZ,1:""),FDA(8991.9,IENS,10.2)="NOW" "RTN","XUMVIENU",269,0) . D FILER(.FDA,"E",.XURET) "RTN","XUMVIENU",270,0) . ; "RTN","XUMVIENU",271,0) . ;Lookup or add corresponding entry in New Person NEW DEA #'S multiple "RTN","XUMVIENU",272,0) . S IEN=$O(^VA(200,+XUDUZ,"PS4","B",DEA,0)) "RTN","XUMVIENU",273,0) . I IEN'>0 D Q:IEN'>0 "RTN","XUMVIENU",274,0) .. K FDA "RTN","XUMVIENU",275,0) .. S FDA(200.5321,"+1,"_+XUDUZ_",",.01)=DEA "RTN","XUMVIENU",276,0) .. S IEN=$$UPDATER(.FDA,"E",.XURET) "RTN","XUMVIENU",277,0) . ; "RTN","XUMVIENU",278,0) . ;Update the DEA POINTER value in the NEW DEA #'s multiple "RTN","XUMVIENU",279,0) . K FDA "RTN","XUMVIENU",280,0) . S FDA(200.5321,+IEN_","_+XUDUZ_",",.03)=NDEAIEN "RTN","XUMVIENU",281,0) . D FILER(.FDA,"",.XURET) "RTN","XUMVIENU",282,0) Q "RTN","XUMVIENU",283,0) ; "RTN","XUMVIENU",284,0) NPDEA(XUDUZ,XUARR,XURET) ;Set the single-valued fields in the New Person file for "RTN","XUMVIENU",285,0) ; DEA#, Detox #, DEA Expiration Date, and the Schedule fields from the first entry in "RTN","XUMVIENU",286,0) ; the NEW DEA#'s multiple; Also default Auth to Write Med Orders to 1 if not already set, "RTN","XUMVIENU",287,0) ; WHO is 200PIEV, and there's a DEA# "RTN","XUMVIENU",288,0) N DEAIEN,FDA,IENS,ND0,ND2,NDEAIEN "RTN","XUMVIENU",289,0) S DEAIEN=$O(^VA(200,XUDUZ,"PS4",0)) Q:'DEAIEN "RTN","XUMVIENU",290,0) S NDEAIEN=$P(^VA(200,XUDUZ,"PS4",DEAIEN,0),U,3) Q:NDEAIEN'>0 "RTN","XUMVIENU",291,0) ; "RTN","XUMVIENU",292,0) ;Set up FDA with data from DEA NUMBERS entry "RTN","XUMVIENU",293,0) S IENS=+XUDUZ_"," "RTN","XUMVIENU",294,0) S ND0=$G(^XTV(8991.9,+NDEAIEN,0)),ND2=$G(^(2)) Q:$P(ND0,U)="" "RTN","XUMVIENU",295,0) S FDA(200,IENS,53.2)=$P(ND0,U) ;DEA# "RTN","XUMVIENU",296,0) S FDA(200,IENS,53.11)=$P(ND0,U,3) ;DETOX NUMBER "RTN","XUMVIENU",297,0) S FDA(200,IENS,747.44)=$P(ND0,U,4) ;DEA EXPIRATION DATE "RTN","XUMVIENU",298,0) S FDA(200,IENS,55.1)=$P(ND2,U) ;SCHEDULE II NARCOTIC "RTN","XUMVIENU",299,0) S FDA(200,IENS,55.2)=$P(ND2,U,2) ;SCHEDULE II NON-NARCOTIC "RTN","XUMVIENU",300,0) S FDA(200,IENS,55.3)=$P(ND2,U,3) ;SCHEDULE III NARCOTIC "RTN","XUMVIENU",301,0) S FDA(200,IENS,55.4)=$P(ND2,U,4) ;SCHEDULE III NON-NARCOTIC "RTN","XUMVIENU",302,0) S FDA(200,IENS,55.5)=$P(ND2,U,5) ;SCHEDULE IV "RTN","XUMVIENU",303,0) S FDA(200,IENS,55.6)=$P(ND2,U,6) ;SCHEDULE V "RTN","XUMVIENU",304,0) I $G(XUARR("WHO"))="200PIEV",$G(XUARR("AuthWriteMedOrders"))="" S FDA(200,IENS,53.1)=1 "RTN","XUMVIENU",305,0) D FILER(.FDA,"",.XURET) "RTN","XUMVIENU",306,0) Q "RTN","XUMVIENU",307,0) ; "RTN","XUMVIENU",308,0) FIRSTDEA(XUDUZ,XUARR,XURET) ;File the first valid DEA in the XUARR input array "RTN","XUMVIENU",309,0) ;into the single-value DEA fields of the NP file "RTN","XUMVIENU",310,0) N CNT,DEA,FDA,FIRST,IENS "RTN","XUMVIENU",311,0) ; "RTN","XUMVIENU",312,0) ;Find the first valid DEA number in the input array "RTN","XUMVIENU",313,0) S FIRST="",CNT=0 F S CNT=$O(XUARR("DEA",CNT)) Q:'CNT D Q:FIRST "RTN","XUMVIENU",314,0) . S DEA=$G(XUARR("DEA",CNT,"DEA")) Q:DEA="" "RTN","XUMVIENU",315,0) . S DEA=$$GETINT(200,53.2,DEA) "RTN","XUMVIENU",316,0) . S:DEA'=U FIRST=CNT "RTN","XUMVIENU",317,0) Q:'FIRST "RTN","XUMVIENU",318,0) ; "RTN","XUMVIENU",319,0) ;Set up FDA with data from DEA NUMBERS entry "RTN","XUMVIENU",320,0) S IENS=XUDUZ_"," "RTN","XUMVIENU",321,0) S FDA(200,IENS,53.2)=DEA "RTN","XUMVIENU",322,0) S:$D(XUARR("DEA",FIRST,"Detox"))#2 FDA(200,IENS,53.11)=XUARR("DEA",FIRST,"Detox") "RTN","XUMVIENU",323,0) S:$D(XUARR("DEA",FIRST,"DEAExpire"))#2 FDA(200,IENS,747.44)=XUARR("DEA",FIRST,"DEAExpire") "RTN","XUMVIENU",324,0) S:$D(XUARR("DEA",FIRST,"SchedIINarc"))#2 FDA(200,IENS,55.1)=XUARR("DEA",FIRST,"SchedIINarc") "RTN","XUMVIENU",325,0) S:$D(XUARR("DEA",FIRST,"SchedIINonNarc"))#2 FDA(200,IENS,55.2)=XUARR("DEA",FIRST,"SchedIINonNarc") "RTN","XUMVIENU",326,0) S:$D(XUARR("DEA",FIRST,"SchedIIINarc"))#2 FDA(200,IENS,55.3)=XUARR("DEA",FIRST,"SchedIIINarc") "RTN","XUMVIENU",327,0) S:$D(XUARR("DEA",FIRST,"SchedIIINonNarc"))#2 FDA(200,IENS,55.4)=XUARR("DEA",FIRST,"SchedIIINonNarc") "RTN","XUMVIENU",328,0) S:$D(XUARR("DEA",FIRST,"SchedIV"))#2 FDA(200,IENS,55.5)=XUARR("DEA",FIRST,"SchedIV") "RTN","XUMVIENU",329,0) S:$D(XUARR("DEA",FIRST,"SchedV"))#2 FDA(200,IENS,55.6)=XUARR("DEA",FIRST,"SchedV") "RTN","XUMVIENU",330,0) I $G(XUARR("WHO"))="200PIEV",$G(XUARR("AuthWriteMedOrders"))="" S FDA(200,IENS,53.1)=1 "RTN","XUMVIENU",331,0) D FILER(.FDA,"E",.XURET) "RTN","XUMVIENU",332,0) Q "RTN","XUMVIENU",333,0) ; "RTN","XUMVIENU",334,0) FILER(XUMVIFDA,FLAG,XURET) ;Call the Filer "RTN","XUMVIENU",335,0) N DIERR,DIHELP,DIMSG,IENS,FILE,ROOT,XUMVIERR "RTN","XUMVIENU",336,0) Q:'$D(XUMVIFDA) "RTN","XUMVIENU",337,0) S FILE=$O(XUMVIFDA(0)),IENS=$O(XUMVIFDA(+FILE,"")),ROOT=$$ROOT^DILFD(FILE,IENS)_+IENS_")" "RTN","XUMVIENU",338,0) I $G(ROOT)="" D ADDERR(.XURET,"Unable to determine global root of File #"_FILE_", IENS '"_IENS_".") Q "RTN","XUMVIENU",339,0) L +@ROOT:10 E D ADDERR(.XURET,"Unable to lock global "_ROOT_".") Q "RTN","XUMVIENU",340,0) D FILE^DIE($G(FLAG),"XUMVIFDA","XUMVIERR") "RTN","XUMVIENU",341,0) L -@ROOT "RTN","XUMVIENU",342,0) D:$G(DIERR) ADDERR(.XURET,$$BLDERR("XUMVIERR")) "RTN","XUMVIENU",343,0) Q "RTN","XUMVIENU",344,0) ; "RTN","XUMVIENU",345,0) UPDATER(XUMVIFDA,FLAG,XURET,XUMVIIEN) ;Call the Updater "RTN","XUMVIENU",346,0) ;**724,Story 1209890 (mko): Add XUMVIIEN as an input paramater to allow controlling IEN of new record "RTN","XUMVIENU",347,0) N DIERR,DIHELP,DIMSG,XUMVIERR "RTN","XUMVIENU",348,0) D UPDATE^DIE(FLAG,"XUMVIFDA","XUMVIIEN","XUMVIERR") "RTN","XUMVIENU",349,0) I $G(DIERR) D ADDERR(.XURET,$$BLDERR("XUMVIERR")) Q 0 "RTN","XUMVIENU",350,0) Q +$G(XUMVIIEN(1)) "RTN","XUMVIENU",351,0) ; "RTN","XUMVIENU",352,0) ADDERR(XURET,MSG) ;Add error MSG to XURET "RTN","XUMVIENU",353,0) Q:$G(MSG)="" "RTN","XUMVIENU",354,0) S XURET=$S(XURET]"":XURET_" ",1:"-1^")_MSG "RTN","XUMVIENU",355,0) Q "RTN","XUMVIENU",356,0) ; "RTN","XUMVIENU",357,0) STATEIEN(STATE) ;Return "`"_IEN if valid abbreviation, VA code, or name "RTN","XUMVIENU",358,0) N IEN "RTN","XUMVIENU",359,0) Q:$G(STATE)="" "" "RTN","XUMVIENU",360,0) S IEN=$S(STATE="FG":$O(^DIC(5,"B","FOREIGN COUNTRY",0)),STATE="OT":$O(^DIC(5,"B","OTHER",0)),STATE="EU":$O(^DIC(5,"B","EUROPE",0)),1:$O(^DIC(5,"C",STATE,0))) "RTN","XUMVIENU",361,0) S:'IEN IEN=$O(^DIC(5,"B",STATE,"")) "RTN","XUMVIENU",362,0) Q $S(IEN>0:"`"_IEN,1:STATE) "RTN","XUMVIENU",363,0) ; "RTN","XUMVIENU",364,0) GETINT(FILE,FLD,VAL) ;Get the internal form of the data; returns "^" if not valid "RTN","XUMVIENU",365,0) N DIERR,DIHELP,DIMSG,XUMSG,XURES "RTN","XUMVIENU",366,0) Q:VAL="" "" "RTN","XUMVIENU",367,0) D CHK^DIE(FILE,FLD,"",VAL,.XURES,"XUMSG") "RTN","XUMVIENU",368,0) Q XURES "RTN","XUMVIENU",369,0) ; "RTN","XUMVIENU",370,0) BLDERR(INROOT) ;Build a string containing error messages returned by FileMan "RTN","XUMVIENU",371,0) N ERRSTR,I,XUERMSGS "RTN","XUMVIENU",372,0) D MSG^DIALOG("AE",.XUERMSGS,"","",$G(INROOT)) "RTN","XUMVIENU",373,0) S ERRSTR="" "RTN","XUMVIENU",374,0) S I=0 F S I=$O(XUERMSGS(I)) Q:'I S:XUERMSGS(I)]"" ERRSTR=ERRSTR_$E(" ",ERRSTR]"")_XUERMSGS(I) "RTN","XUMVIENU",375,0) Q ERRSTR "RTN","XUMVIENU",376,0) ; "RTN","XUMVIENU",377,0) MAXLEN(FILE,FLD) ;Return the maximum length of field FLD in file FILE "RTN","XUMVIENU",378,0) N MAX "RTN","XUMVIENU",379,0) S MAX=$$GET1^DID(+FILE,+FLD,"","FIELD LENGTH") S:MAX'>0 MAX=999 "RTN","XUMVIENU",380,0) Q MAX "RTN","XUMVIENU",381,0) ; "RTN","XUMVIENU",382,0) ;================================================= "RTN","XUMVIENU",383,0) ; Code for storing debugging information in ^XTMP "RTN","XUMVIENU",384,0) ;================================================= "RTN","XUMVIENU",385,0) RECORD(PARAM,FLAG,RPCNAME) ;Record RPC inputs for debugging "RTN","XUMVIENU",386,0) ;Return seq# in ^XTMP "RTN","XUMVIENU",387,0) N NODE,NOW,SEQ,TODAY "RTN","XUMVIENU",388,0) Q:'$$ISDEBUG 0 "RTN","XUMVIENU",389,0) S:$G(RPCNAME)="" RPCNAME="XUS MVI ENRICH NEW PERSON" "RTN","XUMVIENU",390,0) S NOW=$$NOW^XLFDT,TODAY=$P(NOW,".") "RTN","XUMVIENU",391,0) S NODE=$$NODE "RTN","XUMVIENU",392,0) ; "RTN","XUMVIENU",393,0) L +^XTMP(NODE):2 "RTN","XUMVIENU",394,0) D SETXTMP0(NODE) "RTN","XUMVIENU",395,0) S SEQ=$O(^XTMP(NODE," "),-1)+1 "RTN","XUMVIENU",396,0) M ^XTMP(NODE,SEQ,"PARAM")=PARAM "RTN","XUMVIENU",397,0) S ^XTMP(NODE,SEQ,"FLAG")=$G(FLAG) "RTN","XUMVIENU",398,0) S ^XTMP(NODE,SEQ,"DT")=NOW "RTN","XUMVIENU",399,0) S ^XTMP(NODE,SEQ,"DUZ")=$G(DUZ) "RTN","XUMVIENU",400,0) S ^XTMP(NODE,SEQ,"RPC")=RPCNAME "RTN","XUMVIENU",401,0) L -^XTMP(NODE) "RTN","XUMVIENU",402,0) Q SEQ "RTN","XUMVIENU",403,0) ; "RTN","XUMVIENU",404,0) RETURN(SEQ,RETURN) ;Record the return value "RTN","XUMVIENU",405,0) Q:'SEQ Q:'$$ISDEBUG "RTN","XUMVIENU",406,0) M ^XTMP($$NODE,SEQ,"RETURN")=RETURN "RTN","XUMVIENU",407,0) Q "RTN","XUMVIENU",408,0) ; "RTN","XUMVIENU",409,0) DBON ;Set DEBUG on "RTN","XUMVIENU",410,0) N NODE "RTN","XUMVIENU",411,0) S NODE=$$NODE "RTN","XUMVIENU",412,0) D SETXTMP0 "RTN","XUMVIENU",413,0) S ^XTMP(NODE,"DEBUG")=1 "RTN","XUMVIENU",414,0) W !,$NA(^XTMP(NODE,"DEBUG"))_" set to 1.",! "RTN","XUMVIENU",415,0) Q "RTN","XUMVIENU",416,0) ; "RTN","XUMVIENU",417,0) DBOFF ;Set DEBUG off "RTN","XUMVIENU",418,0) N NODE "RTN","XUMVIENU",419,0) S NODE=$$NODE "RTN","XUMVIENU",420,0) K ^XTMP(NODE,"DEBUG") "RTN","XUMVIENU",421,0) K:'$O(^XTMP(NODE,0)) ^XTMP(NODE) "RTN","XUMVIENU",422,0) W !,$NA(^XTMP(NODE,"DEBUG"))_" killed.",! "RTN","XUMVIENU",423,0) Q "RTN","XUMVIENU",424,0) ; "RTN","XUMVIENU",425,0) ISDEBUG() ;Return 1 if DEBUG mode flag is set "RTN","XUMVIENU",426,0) Q $G(^XTMP($$NODE,"DEBUG")) "RTN","XUMVIENU",427,0) ; "RTN","XUMVIENU",428,0) PURGE ;Purge the debugging data stored in ^XTMP "RTN","XUMVIENU",429,0) N ISDEBUG "RTN","XUMVIENU",430,0) S ISDEBUG=$$ISDEBUG "RTN","XUMVIENU",431,0) K ^XTMP($$NODE) "RTN","XUMVIENU",432,0) W !,$NA(^XTMP($$NODE))_" killed.",! "RTN","XUMVIENU",433,0) D:ISDEBUG DBON "RTN","XUMVIENU",434,0) Q "RTN","XUMVIENU",435,0) ; "RTN","XUMVIENU",436,0) SETXTMP0(NODE,DESC,LIFE) ;Set 0 node of ^XTMP(node) "RTN","XUMVIENU",437,0) N CREATEDT "RTN","XUMVIENU",438,0) S:$G(NODE)="" NODE=$$NODE "RTN","XUMVIENU",439,0) S CREATEDT=$S($D(^XTMP(NODE,0))#2:$P(^(0),U,2),1:DT) "RTN","XUMVIENU",440,0) S:'$G(LIFE) LIFE=30 "RTN","XUMVIENU",441,0) S:$G(DESC)="" DESC="New Person RPC Inputs and Outputs" "RTN","XUMVIENU",442,0) S ^XTMP(NODE,0)=$$FMADD^XLFDT(DT,LIFE)_U_CREATEDT_U_DESC "RTN","XUMVIENU",443,0) Q "RTN","XUMVIENU",444,0) ; "RTN","XUMVIENU",445,0) NODE() ;Return ^XTMP Debug subscript "RTN","XUMVIENU",446,0) Q "XU_RPC_DEBUG_NP" "VER") 8.0^22.2 "BLD",3769,6) ^610 **END** **END**