Released DG*5.3*967 SEQ #849 Extracted from mail message **KIDS**:DG*5.3*967^ **INSTALL NAME** DG*5.3*967 "BLD",3351,0) DG*5.3*967^REGISTRATION^0^3181031^y "BLD",3351,1,0) ^^3^3^3180924^^^ "BLD",3351,1,1,0) MASTER VETERAN INDEX VISTA ENHANCEMENTS - MVI SENSITIVITY "BLD",3351,1,2,0) Refer to patch DG*5.3*967 in the FORUM Patch Module for a complete "BLD",3351,1,3,0) description. "BLD",3351,4,0) ^9.64PA^38.1^1 "BLD",3351,4,38.1,0) 38.1 "BLD",3351,4,38.1,2,0) ^9.641^38.1^1 "BLD",3351,4,38.1,2,38.1,0) DG SECURITY LOG (File-top level) "BLD",3351,4,38.1,2,38.1,1,0) ^9.6411^2^1 "BLD",3351,4,38.1,2,38.1,1,2,0) SECURITY LEVEL "BLD",3351,4,38.1,222) y^n^p^^^^n^^n "BLD",3351,4,38.1,224) "BLD",3351,4,"APDD",38.1,38.1) "BLD",3351,4,"APDD",38.1,38.1,2) "BLD",3351,4,"B",38.1,38.1) "BLD",3351,6.3) 3 "BLD",3351,"INIT") POST^DG967PST "BLD",3351,"KRN",0) ^9.67PA^779.2^20 "BLD",3351,"KRN",.4,0) .4 "BLD",3351,"KRN",.401,0) .401 "BLD",3351,"KRN",.402,0) .402 "BLD",3351,"KRN",.403,0) .403 "BLD",3351,"KRN",.5,0) .5 "BLD",3351,"KRN",.84,0) .84 "BLD",3351,"KRN",3.6,0) 3.6 "BLD",3351,"KRN",3.8,0) 3.8 "BLD",3351,"KRN",9.2,0) 9.2 "BLD",3351,"KRN",9.8,0) 9.8 "BLD",3351,"KRN",9.8,"NM",0) ^9.68A^5^5 "BLD",3351,"KRN",9.8,"NM",1,0) VAFCTR^^0^B6623304 "BLD",3351,"KRN",9.8,"NM",2,0) DG967PST^^0^B32284319 "BLD",3351,"KRN",9.8,"NM",3,0) VAFCQRY^^0^B27513336 "BLD",3351,"KRN",9.8,"NM",4,0) VAFCSB^^0^B50707887 "BLD",3351,"KRN",9.8,"NM",5,0) DPTLK7^^0^B199815452 "BLD",3351,"KRN",9.8,"NM","B","DG967PST",2) "BLD",3351,"KRN",9.8,"NM","B","DPTLK7",5) "BLD",3351,"KRN",9.8,"NM","B","VAFCQRY",3) "BLD",3351,"KRN",9.8,"NM","B","VAFCSB",4) "BLD",3351,"KRN",9.8,"NM","B","VAFCTR",1) "BLD",3351,"KRN",19,0) 19 "BLD",3351,"KRN",19.1,0) 19.1 "BLD",3351,"KRN",101,0) 101 "BLD",3351,"KRN",409.61,0) 409.61 "BLD",3351,"KRN",771,0) 771 "BLD",3351,"KRN",779.2,0) 779.2 "BLD",3351,"KRN",870,0) 870 "BLD",3351,"KRN",8989.51,0) 8989.51 "BLD",3351,"KRN",8989.52,0) 8989.52 "BLD",3351,"KRN",8994,0) 8994 "BLD",3351,"KRN","B",.4,.4) "BLD",3351,"KRN","B",.401,.401) "BLD",3351,"KRN","B",.402,.402) "BLD",3351,"KRN","B",.403,.403) "BLD",3351,"KRN","B",.5,.5) "BLD",3351,"KRN","B",.84,.84) "BLD",3351,"KRN","B",3.6,3.6) "BLD",3351,"KRN","B",3.8,3.8) "BLD",3351,"KRN","B",9.2,9.2) "BLD",3351,"KRN","B",9.8,9.8) "BLD",3351,"KRN","B",19,19) "BLD",3351,"KRN","B",19.1,19.1) "BLD",3351,"KRN","B",101,101) "BLD",3351,"KRN","B",409.61,409.61) "BLD",3351,"KRN","B",771,771) "BLD",3351,"KRN","B",779.2,779.2) "BLD",3351,"KRN","B",870,870) "BLD",3351,"KRN","B",8989.51,8989.51) "BLD",3351,"KRN","B",8989.52,8989.52) "BLD",3351,"KRN","B",8994,8994) "BLD",3351,"QDEF") ^^^^^^^^^^YES "BLD",3351,"QUES",0) ^9.62^^ "BLD",3351,"REQB",0) ^9.611^2^2 "BLD",3351,"REQB",1,0) DG*5.3*926^2 "BLD",3351,"REQB",2,0) DG*5.3*944^2 "BLD",3351,"REQB","B","DG*5.3*926",1) "BLD",3351,"REQB","B","DG*5.3*944",2) "FIA",38.1) DG SECURITY LOG "FIA",38.1,0) ^DGSL(38.1, "FIA",38.1,0,0) 38.1IP "FIA",38.1,0,1) y^n^p^^^^n^^n "FIA",38.1,0,10) "FIA",38.1,0,11) "FIA",38.1,0,"RLRO") "FIA",38.1,0,"VR") 5.3^DG "FIA",38.1,38.1) 1 "FIA",38.1,38.1,2) "INIT") POST^DG967PST "IX",38.1,38.1,"AVAFC2",0) 38.1^AVAFC2^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^38.1^^^^^A "IX",38.1,38.1,"AVAFC2",.1,0) ^^5^5^3180814 "IX",38.1,38.1,"AVAFC2",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",38.1,38.1,"AVAFC2",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",38.1,38.1,"AVAFC2",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",38.1,38.1,"AVAFC2",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",38.1,38.1,"AVAFC2",.1,5,0) the information available at the time of the event. "IX",38.1,38.1,"AVAFC2",1) D FC^DGFCPROT(.DA,38.1,2,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",38.1,38.1,"AVAFC2",2) D FC^DGFCPROT(.DA,38.1,2,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",38.1,38.1,"AVAFC2",11.1,0) ^.114IA^1^1 "IX",38.1,38.1,"AVAFC2",11.1,1,0) 1^F^38.1^2^^^F "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813^2970721^12541 "PKG",5,22,1,"PAH",1,0) 967^3181031 "PKG",5,22,1,"PAH",1,1,0) ^^3^3^3181031 "PKG",5,22,1,"PAH",1,1,1,0) MASTER VETERAN INDEX VISTA ENHANCEMENTS - MVI SENSITIVITY "PKG",5,22,1,"PAH",1,1,2,0) Refer to patch DG*5.3*967 in the FORUM Patch Module for a complete "PKG",5,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") YES "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") 5 "RTN","DG967PST") 0^2^B32284319^n/a "RTN","DG967PST",1,0) DG967PST ;BIR/CML-PATCH DG*5.3*967 POST INSTALLATION ROUTINE ;8/14/18 "RTN","DG967PST",2,0) ;;5.3;Registration;**967**;Aug 13, 1993;Build 3 "RTN","DG967PST",3,0) ; "RTN","DG967PST",4,0) ; - Story 783361 (cml) DG*5.3*967 "RTN","DG967PST",5,0) ; This post-init will loop thru the DG SECURITY LOG FILE (#38.1) and identify entries that are marked as "sensitive". "RTN","DG967PST",6,0) ; The job will be scheduled to run after 10:00pm local time. "RTN","DG967PST",7,0) ; Any records that are found will trigger an A31 message to the MPI. "RTN","DG967PST",8,0) ; When the job is complete it will send an email with stats to: "RTN","DG967PST",9,0) ; - (locally) POSTMASTER and the person who installed the patch (DUZ) "RTN","DG967PST",10,0) ; - (MPI Outlook) Christine.Chesney@domain.ext, Link.Christine@domain.ext and John.Williams30ec0c@domain.ext. "RTN","DG967PST",11,0) ; "RTN","DG967PST",12,0) ; - Story 827326 (cml) DG*5.3*967 "RTN","DG967PST",13,0) ; This post-init will loop thru the Patient file (#2) and look for any records with the ZIP+4 field (#.1112) that contains a "-". "RTN","DG967PST",14,0) ; The job will be scheduled to run after 10:00pm local time. "RTN","DG967PST",15,0) ; Any records that are found will strip out the dash and reset the field which will put the edit in the ADT/HL7 PIVOT file (#391.71) "RTN","DG967PST",16,0) ; When the job is complete it will send an email with stats to: "RTN","DG967PST",17,0) ; - (locally) POSTMASTER and the person who installed the patch (DUZ) "RTN","DG967PST",18,0) ; - (MPI Outlook) Christine.Chesney@domain.ext, Link.Christine@domain.ext and John.Williams30ec0c@domain.ext. "RTN","DG967PST",19,0) ; "RTN","DG967PST",20,0) POST ;queue off post-init to identify patients marked as "sensitive" and trigger A31 to MPI and clean up ZIP+4 records "RTN","DG967PST",21,0) N DGI,DGFLDS "RTN","DG967PST",22,0) D BMES^XPDUTL("Post-Install for Sensitivity Seeding/ZIP+4 Cleanup:") ;,MES^XPDUTL("") "RTN","DG967PST",23,0) I $$PATCH^XPDUTL("DG*5.3*967") D BMES^XPDUTL("Post-Install for Sensitivity Seeding/ZIP+4 previously run.") Q "RTN","DG967PST",24,0) D QUE ;Task off seeding job of sensitivity updates to MPI and ZIP+4 cleanup "RTN","DG967PST",25,0) D BMES^XPDUTL("Post-Install for Sensitivity Seeding/ZIP4 Queued.") "RTN","DG967PST",26,0) Q "RTN","DG967PST",27,0) ; "RTN","DG967PST",28,0) QUE ; Queue off seeding job of sensitivity updates to MPI and ZIP+4 cleanup to run after 10:00pm "RTN","DG967PST",29,0) D BMES^XPDUTL(" Queuing job to seed sensitivity updates to MPI/ZIP+4 cleanup after 10:00pm.") "RTN","DG967PST",30,0) N DAY,DONE,QQ,TIME,ZTIO,ZTSK,ZTRTN,ZTDESC,ZTSAVE,ZTDTH,Y "RTN","DG967PST",31,0) S ZTIO="",ZTRTN="SECLOOP^DG967PST" "RTN","DG967PST",32,0) ;schedule job after 10:00pm "RTN","DG967PST",33,0) K SCH S QQ=$$NOW^XLFDT,DAY=$P(QQ,"."),TIME=$P(QQ,".",2) "RTN","DG967PST",34,0) I TIME<"215900" S SCH=DAY_".2205" "RTN","DG967PST",35,0) I TIME>"220000" S SCH=$$NOW^XLFDT "RTN","DG967PST",36,0) S ZTDTH=SCH "RTN","DG967PST",37,0) S ZTDESC="DG*5.3*967 post-install seeding sensitivity updates and ZIP+4 cleanup." "RTN","DG967PST",38,0) D ^%ZTLOAD "RTN","DG967PST",39,0) I '$G(ZTSK) D MES^XPDUTL(" **** Queuing job failed!!!") Q "RTN","DG967PST",40,0) D MES^XPDUTL(" Job number #"_ZTSK_" was queued.") "RTN","DG967PST",41,0) Q "RTN","DG967PST",42,0) ; "RTN","DG967PST",43,0) SECLOOP ; entry point for queued job to loop on DG SECURITY LOG FILE "RTN","DG967PST",44,0) N DFNCNT,DFN,ICN,SENSI,A31CNT,START,TRY,DONE "RTN","DG967PST",45,0) S START=$$FMTE^XLFDT($$NOW^XLFDT) "RTN","DG967PST",46,0) S (DFNCNT,DFN,A31CNT)=0 "RTN","DG967PST",47,0) F S DFN=$O(^DGSL(38.1,DFN)) Q:'DFN S DFNCNT=DFNCNT+1 D "RTN","DG967PST",48,0) .I $D(^DPT(DFN,-9)) Q "RTN","DG967PST",49,0) .S SENSI=$P(^DGSL(38.1,DFN,0),"^",2) I SENSI D "RTN","DG967PST",50,0) ..S ICN=$P($G(^DPT(DFN,"MPI")),"^") I ICN S A31CNT=A31CNT+1 S TRY=$$A31^MPIFA31B(DFN) "RTN","DG967PST",51,0) ; "RTN","DG967PST",52,0) S DONE=$$FMTE^XLFDT($$NOW^XLFDT) "RTN","DG967PST",53,0) ; "RTN","DG967PST",54,0) EMAILS1 ; Send email to person who ran the INIT, letting them know results "RTN","DG967PST",55,0) N XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,X,R "RTN","DG967PST",56,0) S R(1)="Seeding of patients marked as Sensitive:" "RTN","DG967PST",57,0) S R(2)=" " "RTN","DG967PST",58,0) S R(3)="Process started: "_START "RTN","DG967PST",59,0) S R(4)="Process completed: "_DONE "RTN","DG967PST",60,0) S R(5)="Total number of patients processed : "_DFNCNT "RTN","DG967PST",61,0) S R(6)="Total number of A31 messages triggered to MPI: "_A31CNT "RTN","DG967PST",62,0) S XMTEXT="R(",XMSUB="Result of running patch DG*5.3*967 (Sensitivity Seeding)" "RTN","DG967PST",63,0) S XMDUZ=.5 "RTN","DG967PST",64,0) S XMY(DUZ)="" "RTN","DG967PST",65,0) D ^XMD "RTN","DG967PST",66,0) ; "RTN","DG967PST",67,0) ; Send message to MPI developers on Outlook "RTN","DG967PST",68,0) ; IA#4440 supported call to check for test or production account "RTN","DG967PST",69,0) I $$PROD^XUPROD()=0 G ZIP4LOOP ;not a production account. Don't send email to MPI dev "RTN","DG967PST",70,0) ; "RTN","DG967PST",71,0) N DGSNAME,DGSITE,XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,R "RTN","DG967PST",72,0) S X=$$SITE^VASITE() "RTN","DG967PST",73,0) S DGSNAME=$P(X,"^",2),DGSITE=$P(X,"^",3) "RTN","DG967PST",74,0) S R(1)="Post-Init routine ^DG967PST run at station: "_DGSITE_" - "_DGSNAME "RTN","DG967PST",75,0) S R(2)=" " "RTN","DG967PST",76,0) S R(3)="Seeding of patients marked as Sensitive:" "RTN","DG967PST",77,0) S R(4)="Process Started: "_START_" - Completed: "_DONE "RTN","DG967PST",78,0) S R(5)=" " "RTN","DG967PST",79,0) S R(6)="Total number of patients processed: "_DFNCNT_" " "RTN","DG967PST",80,0) S R(7)="Total number of A31 messages triggered to MPI: "_A31CNT "RTN","DG967PST",81,0) S XMTEXT="R(",XMSUB="Result of running patch DG*5.3*967 (Sensitivity) at station: "_DGSITE "RTN","DG967PST",82,0) S XMDUZ=DUZ "RTN","DG967PST",83,0) S XMY("Christine.Chesney@domain.ext")="" "RTN","DG967PST",84,0) S XMY("John.Williams30ec0c@domain.ext")="" "RTN","DG967PST",85,0) S XMY("Christine.Link@domain.ext")="" "RTN","DG967PST",86,0) D ^XMD "RTN","DG967PST",87,0) ; "RTN","DG967PST",88,0) ZIP4LOOP ; start cleanup of ZIP+4 records "RTN","DG967PST",89,0) N DFNCNT,DFN,NODE,ZIP4,EDZIP,EDCNT,START,DONE "RTN","DG967PST",90,0) S START=$$FMTE^XLFDT($$NOW^XLFDT) "RTN","DG967PST",91,0) S (DFNCNT,DFN,EDCNT)=0 "RTN","DG967PST",92,0) F S DFN=$O(^DPT(DFN)) Q:'DFN S DFNCNT=DFNCNT+1 D "RTN","DG967PST",93,0) .I $D(^DPT(DFN,-9)) Q "RTN","DG967PST",94,0) .S NODE=$G(^DPT(DFN,.11)),ZIP4=$P(NODE,"^",12) I ZIP4["-" S EDCNT=EDCNT+1 D "RTN","DG967PST",95,0) ..S EDZIP=$P(ZIP4,"-")_$P(ZIP4,"-",2) S X=EDZIP,DIE="^DPT(",DA=DFN,DR=".1112///^S X=EDZIP" D ^DIE K DIE,DA,DR "RTN","DG967PST",96,0) ; "RTN","DG967PST",97,0) S DONE=$$FMTE^XLFDT($$NOW^XLFDT) "RTN","DG967PST",98,0) ; "RTN","DG967PST",99,0) EMAILS2 ; Send email to person who ran the INIT, letting them know results "RTN","DG967PST",100,0) N XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,X,R "RTN","DG967PST",101,0) S R(1)="Cleanup of Patient file records having ZIP+4 field (#.1112) with dashes:" "RTN","DG967PST",102,0) S R(2)=" " "RTN","DG967PST",103,0) S R(3)="Process started: "_START "RTN","DG967PST",104,0) S R(4)="Process completed: "_DONE "RTN","DG967PST",105,0) S R(5)="Total number of patients processed : "_DFNCNT "RTN","DG967PST",106,0) S R(6)="Total number of ZIP+4 records edited: "_EDCNT "RTN","DG967PST",107,0) S R(7)=" ",R(8)="You can now delete the post-init routine ^DG967PST." "RTN","DG967PST",108,0) S XMTEXT="R(",XMSUB="Result of running patch DG*5.3*967 (ZIP+4 cleanup)" "RTN","DG967PST",109,0) S XMDUZ=.5 "RTN","DG967PST",110,0) S XMY(DUZ)="" "RTN","DG967PST",111,0) D ^XMD "RTN","DG967PST",112,0) ; "RTN","DG967PST",113,0) ; Send message to MPI developers on Outlook "RTN","DG967PST",114,0) ; IA#4440 supported call to check for test or production account "RTN","DG967PST",115,0) Q:$$PROD^XUPROD()=0 ;not a production account. Don't send email to MPI dev "RTN","DG967PST",116,0) ; "RTN","DG967PST",117,0) N DGSNAME,DGSITE,XMDUZ,XMTEXT,XMSUB,XMY,XMZ,XMDUN,R "RTN","DG967PST",118,0) S X=$$SITE^VASITE() "RTN","DG967PST",119,0) S DGSNAME=$P(X,"^",2),DGSITE=$P(X,"^",3) "RTN","DG967PST",120,0) S R(1)="Post-Init routine ^DG967PST run at station: "_DGSITE_" - "_DGSNAME "RTN","DG967PST",121,0) S R(2)=" " "RTN","DG967PST",122,0) S R(3)="Cleanup of Patient file records having ZIP+4 field (#.1112) with dashes:" "RTN","DG967PST",123,0) S R(4)="Process Started: "_START_" - Completed: "_DONE "RTN","DG967PST",124,0) S R(5)=" " "RTN","DG967PST",125,0) S R(6)="Total number of patients processed: "_DFNCNT_" " "RTN","DG967PST",126,0) S R(7)="Total number of ZIP+4 records edited: "_EDCNT "RTN","DG967PST",127,0) S XMTEXT="R(",XMSUB="Result of running patch DG*5.3*967 (ZIP+4) at station: "_DGSITE "RTN","DG967PST",128,0) S XMDUZ=DUZ "RTN","DG967PST",129,0) S XMY("Christine.Chesney@domain.ext")="" "RTN","DG967PST",130,0) S XMY("John.Williams30ec0c@domain.ext")="" "RTN","DG967PST",131,0) S XMY("Christine.Link@domain.ext")="" "RTN","DG967PST",132,0) D ^XMD "RTN","DG967PST",133,0) Q "RTN","DPTLK7") 0^5^B199815452^B199396274 "RTN","DPTLK7",1,0) DPTLK7 ;OAK/ELZ - MAS PATIENT LOOKUP ENTERPRISE SEARCH ; 8/24/15 2:38pm "RTN","DPTLK7",2,0) ;;5.3;Registration;**915,919,926,967**;Aug 13, 1993;Build 3 "RTN","DPTLK7",3,0) ; "RTN","DPTLK7",4,0) SEARCH(DGX,DGXOLD) ; do a search, pass in what the user entered "RTN","DPTLK7",5,0) ; DGX is what the user originally entered, name is assumed unless it "RTN","DPTLK7",6,0) ; is exactly 9 digits, DON'T pass by reference it may change "RTN","DPTLK7",7,0) ; Return: DFN (new or found locally), 0 if nothing found/added "RTN","DPTLK7",8,0) ; "RTN","DPTLK7",9,0) N DG20NAME,DGMPI,DGFLDS,DGOUT,%,%Y,DGMPIR,DGDFN,DGMPIICN,DGSAVE "RTN","DPTLK7",10,0) N DGKEYREQ,X,DA,DO,DIC,DGADDREQ,DGMCID "RTN","DPTLK7",11,0) Q:$G(DGSEARCH) 0 "RTN","DPTLK7",12,0) S (DGKEYREQ,DGOUT,DGADDREQ)=0,DGSEARCH=1,DGSAVE=DGX "RTN","DPTLK7",13,0) Q:$T(PATIENT^MPIFXMLP)="" 0 "RTN","DPTLK7",14,0) ; "RTN","DPTLK7",15,0) YN ;Enterprise Search? "RTN","DPTLK7",16,0) W !,"Do you want to do an Enterprise Search" "RTN","DPTLK7",17,0) D YN^DICN I %=0 W !,"You must enter Yes or No." G YN "RTN","DPTLK7",18,0) Q:%'=1 0 "RTN","DPTLK7",19,0) ; "RTN","DPTLK7",20,0) I $G(DGXOLD)]"" S DGX=DGXOLD "RTN","DPTLK7",21,0) ; if yes then ask questions "RTN","DPTLK7",22,0) ; if 9 digits entered assume ssn, need to save "RTN","DPTLK7",23,0) PROMPT I DGX?9N S DGFLDS(.09)=DGX,DGX="" "RTN","DPTLK7",24,0) ; if name in "" need to remove "RTN","DPTLK7",25,0) I $E(DGX,1)="""" S DGX=$E(DGX,2,99) "RTN","DPTLK7",26,0) I $E(DGX,$L(DGX))="""" S DGX=$E(DGX,1,$L(DGX)-1) "RTN","DPTLK7",27,0) D NAME(.DGX,.DG20NAME,.DGOUT) Q:DGOUT 0 "RTN","DPTLK7",28,0) D FLDS(.DGFLDS,DG20NAME,.DGOUT) Q:DGOUT 0 "RTN","DPTLK7",29,0) I $G(DGFLDS(.09))'?9N S DGADDREQ=1 "RTN","DPTLK7",30,0) D:DGADDREQ ADDRESS(.DGFLDS,.DGOUT) Q:DGOUT 0 "RTN","DPTLK7",31,0) I DGADDREQ,'$$ADDREQ(.DGFLDS) D G PROMPT "RTN","DPTLK7",32,0) . W !,"You must enter an actual SSN, a COMPLETE Address or Phone to search.",! "RTN","DPTLK7",33,0) . K DGX,DG20NAME,DGFLDS,DGMPI,DGMPIR "RTN","DPTLK7",34,0) . S DGX=DGSAVE "RTN","DPTLK7",35,0) ; "RTN","DPTLK7",36,0) ; call MPI to get data "RTN","DPTLK7",37,0) W !!,"Searching the MVI..." "RTN","DPTLK7",38,0) D FORMAT(.DGMPI,.DG20NAME,.DGFLDS) "RTN","DPTLK7",39,0) D PATIENT^MPIFXMLP(.DGMPIR,.DGMPI) "RTN","DPTLK7",40,0) S DGMCID=$G(DGMPIR("mcid")) "RTN","DPTLK7",41,0) ; "RTN","DPTLK7",42,0) ; too many matches found, they need to get the numbers down, re-prompt "RTN","DPTLK7",43,0) I $G(DGMPIR("count"))>10!($G(DGMPIR("Result"))="QE") D G PROMPT "RTN","DPTLK7",44,0) . W !,$S(DGMPIR("count")>10:DGMPIR("count"),1:"Too many")," records found, you need to provide more specific criteria.",! "RTN","DPTLK7",45,0) . K DGX,DG20NAME,DGFLDS,DGMPI,DGMPIR "RTN","DPTLK7",46,0) . S DGX=DGSAVE "RTN","DPTLK7",47,0) ; "RTN","DPTLK7",48,0) ; no matches found on the MPI offer to add "RTN","DPTLK7",49,0) I '$G(DGMPIR("count")) W !,"No records found on the MVI.",! D Q DGDFN "RTN","DPTLK7",50,0) . S DPTX=$G(DGFLDS(.01)) D ASKADD^DPTLK2 I DPTDFN'>0 S DGDFN=0 Q "RTN","DPTLK7",51,0) . S DGDFN=$$ADD(.DGFLDS,.DG20NAME) Q:'DGDFN "RTN","DPTLK7",52,0) . ; "RTN","DPTLK7",53,0) . ; setup DGMPIR since there was nothing "RTN","DPTLK7",54,0) . M DGMPIR(1)=DGMPI "RTN","DPTLK7",55,0) . S DGMPIR(+$O(DGMPIR(0)),"DFN")=DGDFN "RTN","DPTLK7",56,0) . ; "RTN","DPTLK7",57,0) . S DGMPIR("mcid")=DGMCID "RTN","DPTLK7",58,0) . D MPIADD(.DGMPIR) "RTN","DPTLK7",59,0) ; "RTN","DPTLK7",60,0) ; do I have some records that are in autolink threshold? - key required "RTN","DPTLK7",61,0) S X=0 F S X=$O(DGMPIR(X)) Q:'X I $G(DGMPIR(X,"Score"))'<$G(DGMPIR("matchThreshold")) S DGKEYREQ=1 "RTN","DPTLK7",62,0) ; "RTN","DPTLK7",63,0) ; preset list to select patients "RTN","DPTLK7",64,0) S DGDFN=$$ENP^MPIFVER(.DGMPIR,$G(DGMPIR("matchThreshold")),$G(DGMPIR("dupeThreshold"))) "RTN","DPTLK7",65,0) ; "RTN","DPTLK7",66,0) ; found and selected local patient "RTN","DPTLK7",67,0) I DGDFN>0 Q DGDFN "RTN","DPTLK7",68,0) I DGDFN=-1 S DPTX="" Q 0 "RTN","DPTLK7",69,0) ; "RTN","DPTLK7",70,0) ; need to add new patient based on return from selection "RTN","DPTLK7",71,0) I $D(DGMPIR)>1 K DG20NAME D FORMATR(.DGFLDS,.DGMPIR,.DG20NAME) S DGDFN=$$ADD(.DGFLDS,.DG20NAME) D:DGDFN G QUIT "RTN","DPTLK7",72,0) . ; "RTN","DPTLK7",73,0) . S DGMPIR(+$O(DGMPIR(0)),"DFN")=DGDFN "RTN","DPTLK7",74,0) . ; "RTN","DPTLK7",75,0) . S DGMPIR("mcid")=DGMCID "RTN","DPTLK7",76,0) . D MPIADD(.DGMPIR) "RTN","DPTLK7",77,0) . W ! "RTN","DPTLK7",78,0) . ; "RTN","DPTLK7",79,0) . ; if known to ESR, send Z11 and monitor for return data "RTN","DPTLK7",80,0) . I $G(DGMPIR(1,"Z11")) D "RTN","DPTLK7",81,0) .. W !,"Adding site correlation to MVI " "RTN","DPTLK7",82,0) .. N DGTIME,DGQRY,DGDONE,DGQSTAT "RTN","DPTLK7",83,0) .. S (DGQSTAT,DGDONE)=0 "RTN","DPTLK7",84,0) .. F DGTIME=1:1:60 D "RTN","DPTLK7",85,0) ... I $D(^XTMP("DPTLK7 A24 IN-PROCESS",DGDFN)) W "." H 1 Q "RTN","DPTLK7",86,0) ... ; "RTN","DPTLK7",87,0) ... ; not sending, maybe already sent or it is turned off "RTN","DPTLK7",88,0) ... I 'DGDONE S DGDONE=1 D W "." H 1 Q "RTN","DPTLK7",89,0) .... I $$QRY^DGENQRY(DGDFN) W !,"Enrollment/Eligibility Query processing " "RTN","DPTLK7",90,0) ... ; "RTN","DPTLK7",91,0) ... ; check for status until it is returned, end with set to 60 seconds "RTN","DPTLK7",92,0) ... S DGQRY=$$GET^DGENQRY($$FINDLAST^DGENQRY($G(DGDFN)),.DGQRY) I $G(DGQRY("STATUS"))>2 S DGTIME=60,DGQSTAT=1 Q "RTN","DPTLK7",93,0) ... W "." H 1 "RTN","DPTLK7",94,0) .. I 'DGQSTAT D "RTN","DPTLK7",95,0) ... W !,"Query to ES timed out, proceeding with registration." "RTN","DPTLK7",96,0) ... W !,"The data will be uploaded when received." "RTN","DPTLK7",97,0) .. W !! "RTN","DPTLK7",98,0) ; "RTN","DPTLK7",99,0) ; no one selected but may still need to add based on traits entered "RTN","DPTLK7",100,0) I DGKEYREQ,'$D(^XUSEC("DG MVI ADD PT",DUZ)) D "RTN","DPTLK7",101,0) . W !,"The search returned one or more patients above the Auto-Link threshold," "RTN","DPTLK7",102,0) . W !,"none of them selected. Security key required to add without selection." "RTN","DPTLK7",103,0) E D "RTN","DPTLK7",104,0) . N DPTDFN,DPTX,Y,%,%Y,DGMPIR "RTN","DPTLK7",105,0) . M DGMPIR(1)=DGMPI "RTN","DPTLK7",106,0) . S DPTX=$G(DGFLDS(.01)) D ASKADD^DPTLK2 I DPTDFN'>0 S DGDFN=0 Q "RTN","DPTLK7",107,0) . S DGDFN=$$ADD(.DGFLDS,.DG20NAME) Q:'DGDFN "RTN","DPTLK7",108,0) . S DGMPIR(+$O(DGMPIR(0)),"DFN")=DGDFN "RTN","DPTLK7",109,0) . S DGMPIR("AddType")=$S(DGKEYREQ:"Explicit",1:"Implicit") "RTN","DPTLK7",110,0) . S DGMPIR("mcid")=DGMCID "RTN","DPTLK7",111,0) . D MPIADD(.DGMPIR) "RTN","DPTLK7",112,0) ; "RTN","DPTLK7",113,0) QUIT Q $S(DGDFN:DGDFN,1:0) "RTN","DPTLK7",114,0) ; "RTN","DPTLK7",115,0) MPIADD(DGMPIR) ; - call to add patient to the MPI and store ICN locally "RTN","DPTLK7",116,0) ; - web service call for adding and getting new ICN "RTN","DPTLK7",117,0) I '$G(DGMPIR(+$O(DGMPIR(0)),"ICN")) D "RTN","DPTLK7",118,0) . W !,"Adding patient to the MVI..." "RTN","DPTLK7",119,0) . N DGMPIICN "RTN","DPTLK7",120,0) . I '$D(DGMPIR("AddType")) S DGMPIR("AddType")="Implicit" "RTN","DPTLK7",121,0) . D GETICN^MPIFXMLI(.DGMPIICN,.DGMPIR) "RTN","DPTLK7",122,0) . I $G(DGMPIICN("ICN"))>0 S DGMPIR(+$O(DGMPIR(0)),"ICN")=DGMPIICN("ICN") "RTN","DPTLK7",123,0) . E D Q "RTN","DPTLK7",124,0) .. W !,"Unable to add to MVI!",!,$G(DGMPIICN("ERRTXT")),! "RTN","DPTLK7",125,0) .. S ^XTMP("MPIF EXPLICIT QUEUE",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^MPIF EXPLICIT QUEUE" "RTN","DPTLK7",126,0) .. S ^XTMP("MPIF EXPLICIT QUEUE",DGDFN)=DT_"^"_DGMPIR("AddType")_"^"_$G(DGMPIR(+$O(DGMPIR(0)),"mcid"))_"^"_$G(DGMPIICN("ERRTXT")) "RTN","DPTLK7",127,0) .. S X=$$ICNLC^MPIF001(DGDFN) "RTN","DPTLK7",128,0) ; "RTN","DPTLK7",129,0) ; - need to have MPI do MPI fields "RTN","DPTLK7",130,0) S ^XTMP("DPTLK7 A24 IN-PROCESS",0)=$$FMADD^XLFDT(DT,10)_"^"_DT_"^TRACK PROCESSING OF A24 MESSAGES" "RTN","DPTLK7",131,0) S ^XTMP("DPTLK7 A24 IN-PROCESS",DGDFN)=DT "RTN","DPTLK7",132,0) I $G(DGMPIR(+$O(DGMPIR(0)),"ICN")) D VIC40^MPIFAPI(DGDFN,DGMPIR(+$O(DGMPIR(0)),"ICN")) "RTN","DPTLK7",133,0) Q "RTN","DPTLK7",134,0) ; "RTN","DPTLK7",135,0) NAME(DGX,DG20NAME,DGOUT) ;- ask for name components "RTN","DPTLK7",136,0) N DGC,DGCL,DGCOM,DGCX,DGI,DGY,DIR,X,DGCOMP "RTN","DPTLK7",137,0) START S DGOUT=0 "RTN","DPTLK7",138,0) S DGCOM="FAMILY^GIVEN^MIDDLE^PREFIX^SUFFIX^DEGREE" "RTN","DPTLK7",139,0) S DGCX=" (LAST) NAME^ (FIRST) NAME^ NAME" "RTN","DPTLK7",140,0) S DGCL="1:35^1:25^1:25^1:10^1:10^1:10" "RTN","DPTLK7",141,0) I $G(DGX)'?9N S DGX=$G(DGX) D STDNAME^XLFNAME(.DGX,"C") "RTN","DPTLK7",142,0) S DGX("SUFFIX")=$$CLEANC^XLFNAME(DGX("SUFFIX")) "RTN","DPTLK7",143,0) M DG20NAME=DGX "RTN","DPTLK7",144,0) S DIR("PRE")="D:X'=""@"" NCEVAL^DPTNAME1(DGCOMP,.X)" "RTN","DPTLK7",145,0) W !,"Patient name components--" "RTN","DPTLK7",146,0) F DGI=1:1:6 S DGC($P(DGCOM,U,DGI),DGI)="" "RTN","DPTLK7",147,0) F DGI=1:1:6 Q:DGOUT D "RTN","DPTLK7",148,0) AGAIN .S DGCOMP=$P(DGCOM,U,DGI) "RTN","DPTLK7",149,0) . S DIR("A")=DGCOMP_$P(DGCX,U,DGI) "RTN","DPTLK7",150,0) . S DIR(0)=$S(DGI=1:"F^"_$P(DGCL,U,DGI),1:"FO^"_$P(DGCL,U,DGI)) "RTN","DPTLK7",151,0) . S DIR("PRE")="D NCEVAL^DPTNAME1(DGCOMP,.X)" "RTN","DPTLK7",152,0) . S DIR("B")=$S($D(DG20NAME(DGCOMP)):DG20NAME(DGCOMP),1:$G(DGX(DGCOMP))) "RTN","DPTLK7",153,0) . K:'$L(DIR("B")) DIR("B") "RTN","DPTLK7",154,0) ASK . D ^DIR I $D(DTOUT)!(X=U) S DGOUT=1 Q "RTN","DPTLK7",155,0) . I $A(X)=94 D JUMP^DPTNAME1(.DGI) G AGAIN "RTN","DPTLK7",156,0) . I X="@",DGI=1 W !,$C(7),"Family name cannot be deleted!" G ASK "RTN","DPTLK7",157,0) . I X="@" S DG20NAME(DGCOMP)="" Q "RTN","DPTLK7",158,0) . Q:'$L(X) "RTN","DPTLK7",159,0) . S DG20NAME=X "RTN","DPTLK7",160,0) . I DGCOMP="SUFFIX" S DG20NAME=$$CLEANC^XLFNAME(DG20NAME) "RTN","DPTLK7",161,0) . S DG20NAME=$$FORMAT^XLFNAME7(DG20NAME,1,35,,3,,1,1) "RTN","DPTLK7",162,0) . I '$L(DG20NAME) W " ??",$C(7) G ASK "RTN","DPTLK7",163,0) . W:DG20NAME'=X " (",DG20NAME,")" S DG20NAME(DGCOMP)=DG20NAME "RTN","DPTLK7",164,0) Q:DGOUT "" "RTN","DPTLK7",165,0) ; Reconstruct name "RTN","DPTLK7",166,0) S DG20NAME=$$NAMEFMT^XLFNAME(.DG20NAME,"F","CFL30") "RTN","DPTLK7",167,0) ; Format the .01 value "RTN","DPTLK7",168,0) M DGY=DG20NAME "RTN","DPTLK7",169,0) S DG20NAME=$$FORMAT^XLFNAME7(.DGY,3,30,,2) "RTN","DPTLK7",170,0) ; Check the length "RTN","DPTLK7",171,0) I $L(DG20NAME)<3 D G START "RTN","DPTLK7",172,0) . W !,"Invalid values to use, full name must be at least 3 characters!",$C(7) "RTN","DPTLK7",173,0) . K DG20NAME,DGX,DGCOMP "RTN","DPTLK7",174,0) Q "RTN","DPTLK7",175,0) ; "RTN","DPTLK7",176,0) ADDRESS(DGFLDS,DGOUT) ;- prompt for address "RTN","DPTLK7",177,0) N DGRET,FSTR "RTN","DPTLK7",178,0) ;.111 STREET ADDRESS [LINE 1] (both, free text) "RTN","DPTLK7",179,0) ;.112 STREET ADDRESS [LINE 2] (both, free text) "RTN","DPTLK7",180,0) ;.113 STREET ADDRESS [LINE 3] (both, free text) "RTN","DPTLK7",181,0) ;.114 CITY (both, free text) "RTN","DPTLK7",182,0) ;.115 STATE (external^internal) "RTN","DPTLK7",183,0) ;.116 ZIP CODE (both, free text) "RTN","DPTLK7",184,0) ;.117 COUNTY (external^internal^code) "RTN","DPTLK7",185,0) ;.1171 PROVINCE (both, free text) "RTN","DPTLK7",186,0) ;.1172 POSTAL CODE (both, free text) "RTN","DPTLK7",187,0) ;.1112 ZIP+4 (both, free text) "RTN","DPTLK7",188,0) ;.1173 COUNTRY (external^internal) "RTN","DPTLK7",189,0) ;.121 BAD ADDRESS INDICATOR (external^internal) "RTN","DPTLK7",190,0) W !,"Patient address--" "RTN","DPTLK7",191,0) D EN^DGREGAED(,,,.DGRET) "RTN","DPTLK7",192,0) ; address doesn't prompt for phone but returns it, don't want "RTN","DPTLK7",193,0) ; to overwrite "RTN","DPTLK7",194,0) K DGRET(.131) "RTN","DPTLK7",195,0) M DGFLDS=DGRET "RTN","DPTLK7",196,0) Q "RTN","DPTLK7",197,0) FLDS(DGFLDS,DGNAME,DGOUT) ;- prompt for the various FM fields "RTN","DPTLK7",198,0) ; Data returned in array "RTN","DPTLK7",199,0) ;DGFLDS(.09)=SSN* "RTN","DPTLK7",200,0) ;DGFLDS(.03)=DOB* "RTN","DPTLK7",201,0) ;DGFLDS(.02)=GENDER* "RTN","DPTLK7",202,0) ;DGFLDS(.2403)=MMN "RTN","DPTLK7",203,0) ;DGFLDS(.092)=POB (city) "RTN","DPTLK7",204,0) ;DGFLDS(.093)=POB (state) "RTN","DPTLK7",205,0) ;DGFLDS(994)=MBI "RTN","DPTLK7",206,0) ;DGFLDS(.131)=PHONE "RTN","DPTLK7",207,0) ;DGFLDS("EDIPI")=EDIPI "RTN","DPTLK7",208,0) ; "RTN","DPTLK7",209,0) W !,"Patient identifiers--" "RTN","DPTLK7",210,0) ; SSN is special handling "RTN","DPTLK7",211,0) N DGFLD,DIR,X,Y,DG20NAME "RTN","DPTLK7",212,0) S DIR(0)="F^1:9^K:X'?9N&(X'=""P"")&(X'=""p"") X" "RTN","DPTLK7",213,0) S DIR("A")="SOCIAL SECURITY NUMBER" "RTN","DPTLK7",214,0) S:$D(DGFLDS(.09)) DIR("B")=DGFLDS(.09) "RTN","DPTLK7",215,0) S DIR("?")="Answer with the individual's social security, must be 9 numbers or 'P'." "RTN","DPTLK7",216,0) D ^DIR "RTN","DPTLK7",217,0) I $D(DUOUT) S DGOUT=1 Q "RTN","DPTLK7",218,0) S DGFLDS(.09)=X "RTN","DPTLK7",219,0) K DIR "RTN","DPTLK7",220,0) ; Story 338378 (elz) if pseudo, prompt pseudo reason "RTN","DPTLK7",221,0) I DGFLDS(.09)="P"!(DGFLDS(.09)="p") D PSREASON(.DGFLDS,.DGOUT) Q:DGOUT "RTN","DPTLK7",222,0) ; prompt for EDIPI value before the FM fields "RTN","DPTLK7",223,0) ;S DIR(0)="FO^10^K:X'?10N X" "RTN","DPTLK7",224,0) ;S DIR("A")="EDIPI" "RTN","DPTLK7",225,0) ;S DIR("?")="Answer with the individual's EDIPI, must be 10 numbers." "RTN","DPTLK7",226,0) ;D ^DIR "RTN","DPTLK7",227,0) ;I $D(DUOUT) S DGOUT=1 Q "RTN","DPTLK7",228,0) ;S DGFLDS("EDIPI")=X "RTN","DPTLK7",229,0) ;K DIR "RTN","DPTLK7",230,0) F DGFLD=.03,.02,.2403,.092,.093,994,.131 D Q:$D(DTOUT)!($D(DUOUT)) "RTN","DPTLK7",231,0) . S DIR(0)="2,"_DGFLD_$S(DGFLD=.03:"",DGFLD=.02:"",1:"O") "RTN","DPTLK7",232,0) . D ^DIR "RTN","DPTLK7",233,0) . Q:$D(DIRUT) "RTN","DPTLK7",234,0) . S DGFLDS(DGFLD)=$P(Y,"^") "RTN","DPTLK7",235,0) S:$D(DTOUT)!($D(DUOUT)) DGOUT=1 "RTN","DPTLK7",236,0) I $L($G(DGNAME)) S DGFLDS(.01)=DGNAME "RTN","DPTLK7",237,0) Q "RTN","DPTLK7",238,0) ; "RTN","DPTLK7",239,0) PSREASON(DGFLDS,DGOUT) ; - prompts (and requires) pseudo reason "RTN","DPTLK7",240,0) N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,DPTSET,P "RTN","DPTLK7",241,0) S DPTSET=$P(^DD(2,.0906,0),"^",3) "RTN","DPTLK7",242,0) PSAGAIN S DIR(0)="2,.0906" D ^DIR "RTN","DPTLK7",243,0) I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S DGOUT=1 Q "RTN","DPTLK7",244,0) I Y="" W *7,"??",!!,"Choose from:" D "RTN","DPTLK7",245,0) . F P=1:1 Q:$P(DPTSET,";",P)="" W !,$P($P(DPTSET,";",P),":"),?10,$P($P(DPTSET,";",P),":",2) "RTN","DPTLK7",246,0) . W ! G PSAGAIN "RTN","DPTLK7",247,0) I Y["^" S DGOUT=1 Q "RTN","DPTLK7",248,0) S DGFLDS(.0906)=$P(Y,":") "RTN","DPTLK7",249,0) Q "RTN","DPTLK7",250,0) FORMAT(DGR,DGN,DGF) ; - format data for MPI call "RTN","DPTLK7",251,0) N X "RTN","DPTLK7",252,0) S:$G(DGN("FAMILY"))]"" DGR("Surname")=DGN("FAMILY") "RTN","DPTLK7",253,0) S:$G(DGN("GIVEN"))]"" DGR("FirstName")=DGN("GIVEN") "RTN","DPTLK7",254,0) S:$G(DGN("MIDDLE"))]"" DGR("MiddleName")=DGN("MIDDLE") "RTN","DPTLK7",255,0) S:$G(DGN("SUFFIX"))]"" DGR("Suffix")=DGN("SUFFIX") "RTN","DPTLK7",256,0) S:$G(DGN("PREFIX"))]"" DGR("Prefix")=DGN("PREFIX") "RTN","DPTLK7",257,0) S:$G(DGN("DEGREE"))]"" DGR("Degree")=DGN("DEGREE") "RTN","DPTLK7",258,0) S:$G(DGF(.02))]"" DGR("Gender")=DGF(.02) "RTN","DPTLK7",259,0) S:$G(DGF(.03))]"" DGR("DOB")=DGF(.03) "RTN","DPTLK7",260,0) I $G(DGF(.09))]"",DGF(.09)'="P",DGF(.09)'="p" S DGR("SSN")=DGF(.09) "RTN","DPTLK7",261,0) S:$G(DGF(.2403))]"" DGR("MMN")=DGF(.2403) "RTN","DPTLK7",262,0) S:$G(DGF(.092))]"" DGR("POBCity")=DGF(.092) "RTN","DPTLK7",263,0) S:$G(DGF(.093)) DGR("POBState")=$P($G(^DIC(5,DGF(.093),0)),"^",2) "RTN","DPTLK7",264,0) S:$G(DGF(994))]"" DGR("MBI")=DGF(994) "RTN","DPTLK7",265,0) S:$G(DGF(.131))]"" DGR("ResPhone")=DGF(.131) "RTN","DPTLK7",266,0) S:$D(DGF("EDIPI")) DGR("EDIPI")=DGF("EDIPI") "RTN","DPTLK7",267,0) ; "RTN","DPTLK7",268,0) ; only include address if deliverable "RTN","DPTLK7",269,0) I $G(DGF(.121))]"" D "RTN","DPTLK7",270,0) . S:$G(DGF(.111))]"" DGR("ResAddL1")=DGF(.111) "RTN","DPTLK7",271,0) . S:$G(DGF(.1112))]"" DGR("ResAddZip4")=DGF(.1112) "RTN","DPTLK7",272,0) . S:$G(DGF(.112))]"" DGR("ResAddL2")=DGF(.112) "RTN","DPTLK7",273,0) . S:$G(DGF(.113))]"" DGR("ResAddL3")=DGF(.113) "RTN","DPTLK7",274,0) . S:$G(DGF(.114))]"" DGR("CITY")=DGF(.114) "RTN","DPTLK7",275,0) . S:$P($G(DGF(.115)),"^",2) DGR("ResAddState")=$P($G(^DIC(5,$P(DGF(.115),"^",2),0)),"^",2) "RTN","DPTLK7",276,0) . S:$G(DGF(.1171))]"" DGR("ResAddProvince")=DGF(.1171) "RTN","DPTLK7",277,0) . S:$G(DGF(.1172))]"" DGR("ResAddPCode")=DGF(.1172) "RTN","DPTLK7",278,0) . S:$P($G(DGF(.1173)),"^")]"" DGR("ResAddCountry")=$P(DGF(.1173),"^") "RTN","DPTLK7",279,0) Q "RTN","DPTLK7",280,0) ; "RTN","DPTLK7",281,0) FORMATR(DGF,DGM,DG20NAME) ; - merge MPI and user input (MPI authorative) "RTN","DPTLK7",282,0) N DGX,DGY,DGZ "RTN","DPTLK7",283,0) S DGX=$O(DGM(0)) Q:'DGX "RTN","DPTLK7",284,0) S DG20NAME("FAMILY")=$G(DGM(DGX,"Surname")) "RTN","DPTLK7",285,0) S DG20NAME("GIVEN")=$G(DGM(DGX,"FirstName")) "RTN","DPTLK7",286,0) S DG20NAME("MIDDLE")=$G(DGM(DGX,"MiddleName")) "RTN","DPTLK7",287,0) S DG20NAME("PREFIX")=$G(DGM(DGX,"Prefix")) "RTN","DPTLK7",288,0) S DG20NAME("SUFFIX")=$G(DGM(DGX,"Suffix")) "RTN","DPTLK7",289,0) S DG20NAME("DEGREE")=$G(DGM(DGX,"Degree")) "RTN","DPTLK7",290,0) ;Reconstruct name "RTN","DPTLK7",291,0) S DG20NAME=$$NAMEFMT^XLFNAME(.DG20NAME,"F","CFL30") "RTN","DPTLK7",292,0) ;Format the .01 value "RTN","DPTLK7",293,0) M DGY=DG20NAME "RTN","DPTLK7",294,0) S DGF(.01)=$$FORMAT^XLFNAME7(.DGY,3,30,,2) "RTN","DPTLK7",295,0) S DGF(.02)=$G(DGM(DGX,"Gender")) "RTN","DPTLK7",296,0) S DGF(.03)=$G(DGM(DGX,"DOB")) "RTN","DPTLK7",297,0) S DGF(.09)=$G(DGM(DGX,"SSN")) "RTN","DPTLK7",298,0) S DGF(.2403)=$G(DGM(DGX,"MMN")) "RTN","DPTLK7",299,0) S DGF(.092)=$G(DGM(DGX,"POBCity")) "RTN","DPTLK7",300,0) S DGY=$S($G(DGM(DGX,"POBState"))]"":$O(^DIC(5,"C",DGM(DGX,"POBState"),0)),1:"") "RTN","DPTLK7",301,0) S DGF(.093)=DGY "RTN","DPTLK7",302,0) S:$G(DGM(DGX,"ResAddL1"))]"" DGF(.111)=DGM(DGX,"ResAddL1") "RTN","DPTLK7",303,0) S:$G(DGM(DGX,"ResAddL2"))]"" DGF(.112)=DGM(DGX,"ResAddL2") "RTN","DPTLK7",304,0) S:$G(DGM(DGX,"ResAddL3"))]"" DGF(.113)=DGM(DGX,"ResAddL3") "RTN","DPTLK7",305,0) S:$G(DGM(DGX,"City"))]"" DGF(.114)=DGM(DGX,"City") "RTN","DPTLK7",306,0) S:$G(DGM(DGX,"ResAddCity"))]"" DGF(.114)=DGM(DGX,"ResAddCity") "RTN","DPTLK7",307,0) ; "RTN","DPTLK7",308,0) S DGY=$S($G(DGM(DGX,"ResAddState"))]"":$O(^DIC(5,"C",DGM(DGX,"ResAddState"),0)),1:"") "RTN","DPTLK7",309,0) S:DGY DGF(.115)=DGY "RTN","DPTLK7",310,0) S DGY=$S($G(DGM(DGX,"Country"))]"":$O(^HL(779.004,"B",DGM(DGX,"Country"),0)),1:"") "RTN","DPTLK7",311,0) S:DGY DGF(.1173)=DGY "RTN","DPTLK7",312,0) S DGY=$S($G(DGM(DGX,"ResAddCountry"))]"":$O(^HL(779.004,"B",DGM(DGX,"ResAddCountry"),0)),1:"") "RTN","DPTLK7",313,0) S:DGY DGF(.1173)=DGY "RTN","DPTLK7",314,0) S:$G(DGM(DGX,"PCode"))]"" DGF(.1172)=DGM(DGX,"PCode") "RTN","DPTLK7",315,0) S:$G(DGM(DGX,"ResAddPCode"))]"" DGF(.1172)=DGM(DGX,"ResAddPCode") "RTN","DPTLK7",316,0) S:$G(DGM(DGX,"Province"))]"" DGF(.1171)=DGM(DGX,"Province") "RTN","DPTLK7",317,0) S:$G(DGM(DGX,"ResAddProvince"))]"" DGF(.1171)=DGM(DGX,"ResAddProvince") "RTN","DPTLK7",318,0) ;**967, Story 827326 (jfw) - Ensure Dash is removed if exists "RTN","DPTLK7",319,0) S:$G(DGM(DGX,"ResAddZip4"))]"" DGF(.1112)=$TR(DGM(DGX,"ResAddZip4"),"-","") "RTN","DPTLK7",320,0) S:$G(DGM(DGX,"ResPhone"))]"" DGF(.131)=DGM(DGX,"ResPhone") "RTN","DPTLK7",321,0) I $G(DGF(.1112)) D "RTN","DPTLK7",322,0) . N DGX,DGCNTY "RTN","DPTLK7",323,0) . D POSTAL^XIPUTIL(DGF(.1112),.DGX) "RTN","DPTLK7",324,0) . I $G(DGX("FIPS CODE"))]"",$G(DGX("STATE POINTER")) D "RTN","DPTLK7",325,0) .. S DGCNTY=$$FIND1^DIC(5.01,","_DGX("STATE POINTER")_",","MOXQ",$E($G(DGX("FIPS CODE")),3,5),"C") "RTN","DPTLK7",326,0) . I $D(DGCNTY) S DGF(.117)=DGCNTY "RTN","DPTLK7",327,0) ; alias loop "RTN","DPTLK7",328,0) S DGZ=0 F S DGZ=$O(DGM(DGX,"ALIAS",DGZ)) Q:'DGZ D "RTN","DPTLK7",329,0) . N DGY,DG20NAME "RTN","DPTLK7",330,0) . I $G(DGM(DGX,"ALIAS",DGZ,"Surname"))]"" D "RTN","DPTLK7",331,0) .. S DG20NAME("FAMILY")=$G(DGM(DGX,"ALIAS",DGZ,"Surname")) "RTN","DPTLK7",332,0) .. S DG20NAME("GIVEN")=$G(DGM(DGX,"ALIAS",DGZ,"FirstName")) "RTN","DPTLK7",333,0) .. S DG20NAME("MIDDLE")=$G(DGM(DGX,"ALIAS",DGZ,"MiddleName")) "RTN","DPTLK7",334,0) .. S DG20NAME("PREFIX")=$G(DGM(DGX,"ALIAS",DGZ,"Prefix")) "RTN","DPTLK7",335,0) .. S DG20NAME("SUFFIX")=$G(DGM(DGX,"ALIAS",DGZ,"Suffix")) "RTN","DPTLK7",336,0) .. S DG20NAME("DEGREE")=$G(DGM(DGX,"ALIAS",DGZ,"Degree")) "RTN","DPTLK7",337,0) .. ;Reconstruct name "RTN","DPTLK7",338,0) .. S DG20NAME=$$NAMEFMT^XLFNAME(.DG20NAME,"F","CFL30") "RTN","DPTLK7",339,0) .. ;Format the .01 value "RTN","DPTLK7",340,0) .. M DGY=DG20NAME "RTN","DPTLK7",341,0) .. S DGF("ALIAS",DGZ,.01)=$$FORMAT^XLFNAME7(.DGY,3,30,,2) "RTN","DPTLK7",342,0) . I $G(DGM(DGX,"ALIAS",DGZ,"SSN"))]"" S DGF("ALIAS",DGZ,1)=DGM(DGX,"ALIAS",DGZ,"SSN") "RTN","DPTLK7",343,0) S:$G(DGM(DGX,"ICN"))]"" DGF("ICN")=DGM(DGX,"ICN") "RTN","DPTLK7",344,0) ; "RTN","DPTLK7",345,0) ; - Story 338378 (elz) handle pseudo SSN "RTN","DPTLK7",346,0) I $G(DGF(.09))'?9N S DGF(.09)=$$PSEUDO($G(DGF(.01)),$G(DGF(.03))) "RTN","DPTLK7",347,0) E K DGF(.0906) ; remove pseudo reason if we have a ssn "RTN","DPTLK7",348,0) ; "RTN","DPTLK7",349,0) Q "RTN","DPTLK7",350,0) ADD(DGF,DG20NAME) ; - stuff in patient "RTN","DPTLK7",351,0) ; Pass in the fields to set in the DGF array. "RTN","DPTLK7",352,0) ; Alaso Name components in DG20NAME array. Returns new DFN "RTN","DPTLK7",353,0) N X,Y,SAVY,FDA,IEN,DATA,DO,DIC,DA,X,DLAYGO,REQ,VAFCNO,DGY,DPTX "RTN","DPTLK7",354,0) I $E($G(DGF(.09)),1,9)'?9N S DGF(.09)=$$PSEUDO(DGF(.01),$G(DGF(.03))) "RTN","DPTLK7",355,0) ; check for SSN already exist "RTN","DPTLK7",356,0) S DGY=$O(^DPT("SSN",DGF(.09),0)) I DGY>0,$D(^DPT(DGY,0)) W *7," SSN Already used by patient '",$P(^(0),"^"),"'." Q 0 "RTN","DPTLK7",357,0) ; "RTN","DPTLK7",358,0) S DIC("DR")="",REQ="^.02^.03^.09^" "RTN","DPTLK7",359,0) S DGF=.01 F S DGF=$O(DGF(DGF)) Q:'DGF D "RTN","DPTLK7",360,0) . ; if the data has a second piece, then that's internal value to use "RTN","DPTLK7",361,0) . S DATA=$S($P(DGF(DGF),"^",2):$P(DGF(DGF),"^",2),1:DGF(DGF)) "RTN","DPTLK7",362,0) . I DATA]""!(REQ[("^"_DGF_"^")) S DIC("DR")=DIC("DR")_DGF_$S(DATA]"":"////"_DATA,1:"")_";" "RTN","DPTLK7",363,0) ; patient type "RTN","DPTLK7",364,0) S DIC("DR")=DIC("DR")_"391///"_$O(^DG(391,"B","NSC VETERAN",0))_";" "RTN","DPTLK7",365,0) ; veteran "RTN","DPTLK7",366,0) S DIC("DR")=DIC("DR")_"1901///Y;" "RTN","DPTLK7",367,0) ; SC "RTN","DPTLK7",368,0) S DIC("DR")=DIC("DR")_".301///N;" "RTN","DPTLK7",369,0) ; date added "RTN","DPTLK7",370,0) S DIC("DR")=DIC("DR")_".097////"_DT "RTN","DPTLK7",371,0) ; who added "RTN","DPTLK7",372,0) S:$G(DUZ) DIC("DR")=DIC("DR")_";.096////"_DUZ "RTN","DPTLK7",373,0) ; "RTN","DPTLK7",374,0) S X=DGF(.01),DIC="^DPT(",DIC(0)="L",DLAYGO=2,VAFCNO=1 "RTN","DPTLK7",375,0) D FILE^DICN "RTN","DPTLK7",376,0) S SAVY=+Y "RTN","DPTLK7",377,0) ; "RTN","DPTLK7",378,0) ; alias "RTN","DPTLK7",379,0) S X=0 F S X=$O(DGF("ALIAS",X)) Q:'X D "RTN","DPTLK7",380,0) . S DGF=0 F S DGF=$O(DGF("ALIAS",X,DGF)) Q:'DGF D "RTN","DPTLK7",381,0) .. S FDA(2.01,"+"_X_","_SAVY_",",.01)=DGF("ALIAS",X,.01) "RTN","DPTLK7",382,0) .. S:DGF("ALIAS",X,1)]"" FDA(2.01,"+"_X_","_SAVY_",",1)=DGF("ALIAS",X,1) "RTN","DPTLK7",383,0) ; "RTN","DPTLK7",384,0) I $D(FDA) D "RTN","DPTLK7",385,0) . N DG20NAME "RTN","DPTLK7",386,0) . D UPDATE^DIE("","FDA") "RTN","DPTLK7",387,0) ; "RTN","DPTLK7",388,0) ; send bulletin new patient added to system "RTN","DPTLK7",389,0) I SAVY>0 D BULL(SAVY) "RTN","DPTLK7",390,0) ; "RTN","DPTLK7",391,0) Q SAVY "RTN","DPTLK7",392,0) ; "RTN","DPTLK7",393,0) ADDREQ(DGFLDS) ; - determine if enough address data entered "RTN","DPTLK7",394,0) ; returns OK to proceed (1) or not (0) "RTN","DPTLK7",395,0) N DGOK,FIELD "RTN","DPTLK7",396,0) S DGOK=1 "RTN","DPTLK7",397,0) ; is US or foreign "RTN","DPTLK7",398,0) I $$FOR^DGADDUTL($P(DGFLDS(.1173),"^")) D "RTN","DPTLK7",399,0) . F FIELD=.111,.114,.1171,.1172 S:$G(DGFLDS(FIELD))']"" DGOK=0 "RTN","DPTLK7",400,0) E F FIELD=.111,.1112,.114,.115 S:$G(DGFLDS(FIELD))']"" DGOK=0 "RTN","DPTLK7",401,0) I $L($G(DGFLDS(.131))) S DGOK=1 "RTN","DPTLK7",402,0) Q DGOK "RTN","DPTLK7",403,0) ; "RTN","DPTLK7",404,0) PSEUDO(NAM,DOB) ; - return pseudo ssn "RTN","DPTLK7",405,0) N L1,L2,L3,Z "RTN","DPTLK7",406,0) S NAM=$G(DGF(.01)),DOB=$G(DGF(.03)) "RTN","DPTLK7",407,0) I DOB="" S DOB=2000000 "RTN","DPTLK7",408,0) S L1=$E($P(NAM," ",2),1),L3=$E(NAM,1),NAM=$P(NAM,",",2),L2=$E(NAM,1) "RTN","DPTLK7",409,0) S Z=L1 D CON^DGRPDD1 S L1=Z,Z=L2 D CON^DGRPDD1 "RTN","DPTLK7",410,0) S L2=Z,Z=L3 D CON^DGRPDD1 S L3=Z "RTN","DPTLK7",411,0) Q L2_L1_L3_$E(DOB,4,7)_$E(DOB,2,3)_"P" "RTN","DPTLK7",412,0) ; "RTN","DPTLK7",413,0) BULL(SAVY) ; - send bulletin that new patient added "RTN","DPTLK7",414,0) N DGTEXT,DGNAM,DGSSN,DGDOB,DGB,DGZ "RTN","DPTLK7",415,0) S DGB=2 "RTN","DPTLK7",416,0) S DGZ=$G(^DPT(SAVY,0)) "RTN","DPTLK7",417,0) S DGNAM=$P(DGZ,"^"),DGSSN=$P(DGZ,"^",9),DGDOB=$P(DGZ,"^",3) "RTN","DPTLK7",418,0) S DGSSN=$E(DGSSN,1,3)_"-"_$E(DGSSN,4,5)_"-"_$E(DGSSN,6,10) "RTN","DPTLK7",419,0) S DGDOB=$$FMTE^XLFDT(DGDOB) "RTN","DPTLK7",420,0) S XMSUB="NEW PATIENT ADDED TO SYSTEM" "RTN","DPTLK7",421,0) S DGTEXT(1,0)="NAME: "_DGNAM "RTN","DPTLK7",422,0) S DGTEXT(2,0)="SSN : "_DGSSN "RTN","DPTLK7",423,0) S DGTEXT(3,0)="DOB : "_DGDOB "RTN","DPTLK7",424,0) D ^DGBUL "RTN","DPTLK7",425,0) Q "RTN","VAFCQRY") 0^3^B27513336^B26626095 "RTN","VAFCQRY",1,0) VAFCQRY ;BIR/DLR-Query for patient demographics ; 8/14/18 4:17pm "RTN","VAFCQRY",2,0) ;;5.3;Registration;**428,575,627,707,863,902,926,967**;Aug 13, 1993;Build 3 "RTN","VAFCQRY",3,0) ; "RTN","VAFCQRY",4,0) IN ;process in the patient query "RTN","VAFCQRY",5,0) N IEN,HLA,VAFCCNT,ICN,CLAIM,SG,VAFCER,VAFC,DFN,STATE,CITY,SUBCOMP,COMP,REP,LVL,LVL2,VAFC,SSN,SAVEDFN "RTN","VAFCQRY",6,0) S VAFCCNT=1,VAFCER=1 "RTN","VAFCQRY",7,0) F VAFC=1:1 X HLNEXT Q:HLQUIT'>0 S SG=$E(HLNODE,1,3) D:$T(@SG)]"" @SG "RTN","VAFCQRY",8,0) S SAVEDFN=$G(DFN) "RTN","VAFCQRY",9,0) D CHKID^VAFCQRY2(.ICN,.SSN,.DFN) "RTN","VAFCQRY",10,0) I $G(DFN)'>0 D "RTN","VAFCQRY",11,0) . ;**863 MVI_2352 if merged send back merged record info for update "RTN","VAFCQRY",12,0) . I SAVEDFN,$D(^DPT(SAVEDFN,-9)) D Q "RTN","VAFCQRY",13,0) .. N DFN,ICN "RTN","VAFCQRY",14,0) .. S DFN=^DPT(SAVEDFN,-9),ICN=$$GETICN^MPIF001(+DFN) "RTN","VAFCQRY",15,0) .. S VAFCER="-1^New Primary record "_DFN_" at site with ICN "_ICN "RTN","VAFCQRY",16,0) . S VAFCER="-1^Unknown ICN#"_$G(ICN)_" and SSN#"_$G(SSN) "RTN","VAFCQRY",17,0) S ^TMP("HLA",$J,VAFCCNT)="MSA"_HL("FS")_"AA"_HL("FS")_HL("MID")_HL("FS")_$S(+$G(VAFCER)'>0:$P(VAFCER,"^",2),1:""),VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",18,0) S ^TMP("HLA",$J,VAFCCNT)=VAFCQRD,VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",19,0) I $G(VAFCER)>0 D BLDRSP(DFN,.VAFCCNT) "RTN","VAFCQRY",20,0) D LINK^HLUTIL3(SITE,.VAFC) S IEN=$O(VAFC(0)) S HLL("LINKS",1)="^"_VAFC(IEN) "RTN","VAFCQRY",21,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"GM",1,.HLRESLTA,"",.HL) "RTN","VAFCQRY",22,0) K VAFCER,VAFCID,COMP,SITE,VAFCFS,VAFCRCV,VAFCQRD,^TMP("HLA",$J) "RTN","VAFCQRY",23,0) Q "RTN","VAFCQRY",24,0) RESP ;Response processing initiated from the MPI. "RTN","VAFCQRY",25,0) Q "RTN","VAFCQRY",26,0) ROUTE ;Routine logic initiated from the MPI. "RTN","VAFCQRY",27,0) Q "RTN","VAFCQRY",28,0) BLDRSP(DFN,VAFCCNT) ; "RTN","VAFCQRY",29,0) N EVN,PID,PD1,SEQ,ERR,CNT,X,PV2,RADE,LABE,PRES "RTN","VAFCQRY",30,0) N SIDG,ZEL,ZSP,NAMECOMP,OLD,PV1,DODF,DODD,DODOPT,DODNP,DODDISDT,SECLVL "RTN","VAFCQRY",31,0) ;construct EVN (for TF Event Type AND Last Treatment Date) "RTN","VAFCQRY",32,0) S SEQ="1,2" D BLDEVN(DFN,.SEQ,.EVN,.HL,"A19",.ERR) S ^TMP("HLA",$J,VAFCCNT)=EVN(1) S VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",33,0) ;construct PID "RTN","VAFCQRY",34,0) S SEQ="ALL" D BLDPID(DFN,1,.SEQ,.PID,.HL,.ERR) S ^TMP("HLA",$J,VAFCCNT)=PID(1) S X=1,CNT=1 F S X=$O(PID(X)) Q:'X I $D(PID(X)) S ^TMP("HLA",$J,VAFCCNT,CNT)=PID(X),CNT=CNT+1 "RTN","VAFCQRY",35,0) S VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",36,0) ;construct PD1 **707 "RTN","VAFCQRY",37,0) ;S SEQ="3" D BLDPD1(DFN,.SEQ,.PD1,.HL,.ERR) S ^TMP("HLA",$J,VAFCCNT)=PD1(1) "RTN","VAFCQRY",38,0) S PD1=$$PD1^VAFCSB I PD1'="" S ^TMP("HLA",$J,VAFCCNT)=PD1,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",39,0) S PV1=$$PV1^VAFCSB I PV1'="" S ^TMP("HLA",$J,VAFCCNT)=PV1,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",40,0) S PV2=$$PV2^VAFCSB I PV2'="" S ^TMP("HLA",$J,VAFCCNT)=PV2,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",41,0) S PRES=$$PHARA^VAFCSB I PRES'="" S ^TMP("HLA",$J,VAFCCNT)=PRES,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",42,0) S LABE=$$LABE^VAFCSB I LABE'="" S ^TMP("HLA",$J,VAFCCNT)=LABE,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",43,0) S RADE=$$RADE^VAFCSB I RADE'="" S ^TMP("HLA",$J,VAFCCNT)=RADE,VAFCCNT=VAFCCNT+1 ;**707 "RTN","VAFCQRY",44,0) S SIDG=$$SIG^VAFCSB(DFN) I $G(SIDG)'="" S ^TMP("HLA",$J,VAFCCNT)=SIDG,VAFCCNT=VAFCCNT+1 ;**902 MVI_4634 (ckn) - OBX FOR SELF ID GENDER "RTN","VAFCQRY",45,0) S NAMECOMP=$$NAMEOBX^VAFCSB(DFN) I $G(NAMECOMP)'="" S ^TMP("HLA",$J,VAFCCNT)=NAMECOMP,VAFCCNT=VAFCCNT+1 ;**902 MVI_4634 (ckn): OBX for Patient .01 and Name Components "RTN","VAFCQRY",46,0) S OLD=$$OLD(DFN) I $G(OLD)'="" S ^TMP("HLA",$J,VAFCCNT)=OLD,VAFCCNT=VAFCCNT+1 ;**902 MVI_4634 (ckn) - OBX to mark and Older record "RTN","VAFCQRY",47,0) S DODF=$$DODF^VAFCSB(DFN) I $G(DODF)'="" S ^TMP("HLA",$J,VAFCCNT)=DODF,VAFCCNT=VAFCCNT+1 ;**902 MVI_4898 (ckn) : OBX for DOD fields "RTN","VAFCQRY",48,0) ;**926 Story 3230009 (ckn) : OBX for Additional DOD fields "RTN","VAFCQRY",49,0) S DODD=$$DODD^VAFCSB(DFN) I $G(DODD)'="" S ^TMP("HLA",$J,VAFCCNT)=DODD,VAFCCNT=VAFCCNT+1 ;Date of Death Documents "RTN","VAFCQRY",50,0) S DODOPT=$$DODOPT^VAFCSB(DFN) I $G(DODOPT)'="" S ^TMP("HLA",$J,VAFCCNT)=DODOPT,VAFCCNT=VAFCCNT+1 ;Date of Death Option "RTN","VAFCQRY",51,0) S DODNP=$$DODNTPRV^VAFCSB(DFN) I $G(DODNP)'="" S ^TMP("HLA",$J,VAFCCNT)=DODNP,VAFCCNT=VAFCCNT+1 ;Date Of Death Notify Provider "RTN","VAFCQRY",52,0) ;**967 - Story 783361 (ckn) - OBX for Security Level "RTN","VAFCQRY",53,0) S SECLVL=$$SECLOG^VAFCSB(DFN) I $G(SECLVL)'="" S ^TMP("HLA",$J,VAFCCNT)=SECLVL,VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",54,0) ;** PATCH 575 "RTN","VAFCQRY",55,0) ;construct ZPD segment "RTN","VAFCQRY",56,0) S SEQ="1,17,21,34" ;**707 Added 1, 21 and 34 to ZPD fields "RTN","VAFCQRY",57,0) S ^TMP("HLA",$J,VAFCCNT)=$$EN1^VAFHLZPD(DFN,SEQ) "RTN","VAFCQRY",58,0) S VAFCCNT=VAFCCNT+1 "RTN","VAFCQRY",59,0) ;**902 MVI_4634 (ckn) - Add ZSP and ZEL segments "RTN","VAFCQRY",60,0) S ZSP=$$EN^VAFHLZSP(DFN) I $G(ZSP)'="" S ^TMP("HLA",$J,VAFCCNT)=ZSP,VAFCCNT=VAFCCNT+1 ;ZSP segment "RTN","VAFCQRY",61,0) S ZEL=$$EN^VAFHLZEL(DFN,"1,8,9",1) I $G(ZEL)'="" S ^TMP("HLA",$J,VAFCCNT)=ZEL,VAFCCNT=VAFCCNT+1 ;ZEL segment "RTN","VAFCQRY",62,0) Q "RTN","VAFCQRY",63,0) MSH ;process MSH segment "RTN","VAFCQRY",64,0) S VAFCFS=HL("FS") "RTN","VAFCQRY",65,0) S HLQ=HL("Q"),HLFS=HL("FS"),HLECH=HL("ECH") "RTN","VAFCQRY",66,0) S VAFCID=HL("MID") "RTN","VAFCQRY",67,0) S COMP=$E(HL("ECH"),1) "RTN","VAFCQRY",68,0) S REP=$E(HL("ECH"),2) "RTN","VAFCQRY",69,0) S SUBCOMP=$E(HL("ECH"),4) "RTN","VAFCQRY",70,0) S SITE=$$LKUP^XUAF4($P($P(HLNODE,HL("FS"),4),COMP)) "RTN","VAFCQRY",71,0) Q "RTN","VAFCQRY",72,0) QRD ;process QRD segment "RTN","VAFCQRY",73,0) N QRD,X,IDS,WSF,ID,QRDAA,QRDNTC "RTN","VAFCQRY",74,0) S VAFCQRD=HLNODE "RTN","VAFCQRY",75,0) S VAFCRCV=$P(VAFCQRD,HL("FS"),5) "RTN","VAFCQRY",76,0) S IDS=$P(VAFCQRD,HL("FS"),9) "RTN","VAFCQRY",77,0) F X=1:1:$L(IDS,REP) S WSF=$P(IDS,REP,X) D "RTN","VAFCQRY",78,0) . ;get id, assigning authority, and name type code "RTN","VAFCQRY",79,0) . S ID=$P(WSF,COMP),QRDAA=$P($P(WSF,COMP,9),SUBCOMP),QRDNTC=$P(WSF,COMP,10) "RTN","VAFCQRY",80,0) . ;check assigning authority(0363) AND name type code(0203) "RTN","VAFCQRY",81,0) . I QRDAA="USVHA" D "RTN","VAFCQRY",82,0) .. I QRDNTC="NI" S ICN=ID ;National unique individual identifier "RTN","VAFCQRY",83,0) .. I QRDNTC="PI" S DFN=ID ;Patient internal identifier "RTN","VAFCQRY",84,0) . I QRDAA="USSSA" D "RTN","VAFCQRY",85,0) .. I QRDNTC="SS" S SSN=ID ;Social Security number "RTN","VAFCQRY",86,0) Q "RTN","VAFCQRY",87,0) BLDEVN(DFN,SEQ,EVN,HL,EVR,ERR) ;build EVN for TF last treatment date and event reason "RTN","VAFCQRY",88,0) ; At this point only sequence one and two are supported "RTN","VAFCQRY",89,0) ; Variable list "RTN","VAFCQRY",90,0) ; DFN - internal PATIENT (#2) number "RTN","VAFCQRY",91,0) ; SEQ - variable consisting of sequence numbers delimited by commas "RTN","VAFCQRY",92,0) ; that will be used to build the message "RTN","VAFCQRY",93,0) ; EVN (passed by reference) - array location to place EVN segment result, the array can have existing values when passed. "RTN","VAFCQRY",94,0) ; HL - array that contains the necessary HL variables (init^hlsub) "RTN","VAFCQRY",95,0) ; EVR - event reason that triggered this message "RTN","VAFCQRY",96,0) ; ERR - array that is used to return an error "RTN","VAFCQRY",97,0) ; "RTN","VAFCQRY",98,0) D BLDEVN^VAFCQRY2(DFN,SEQ,.EVN,.HL,EVR,.ERR) "RTN","VAFCQRY",99,0) Q "RTN","VAFCQRY",100,0) BLDPD1(DFN,SEQ,PD1,HL,ERR) ; "RTN","VAFCQRY",101,0) ; At this point only sequence 3 is supported "RTN","VAFCQRY",102,0) ; Variable list "RTN","VAFCQRY",103,0) ; DFN - internal PATIENT (#2) number "RTN","VAFCQRY",104,0) ; SEQ - variable consisting of sequence numbers delimited by commas "RTN","VAFCQRY",105,0) ; that will be used to build the message "RTN","VAFCQRY",106,0) ; PD1 (passed by reference) - array location to place PD1 segment result, the array can have existing values when passed. "RTN","VAFCQRY",107,0) ; HL - array that contains the necessary HL variables (init^hlsub) "RTN","VAFCQRY",108,0) ; ERR - array that is used to return an error "RTN","VAFCQRY",109,0) ; "RTN","VAFCQRY",110,0) D BLDPD1^VAFCQRY2(DFN,SEQ,.PD1,.HL,.ERR) "RTN","VAFCQRY",111,0) Q "RTN","VAFCQRY",112,0) BLDPID(DFN,CNT,SEQ,PID,HL,ERR) ;build PID from File #2 "RTN","VAFCQRY",113,0) ;The required sequences 3 and 5 will be returned and at this point "RTN","VAFCQRY",114,0) ;sequences 1-3,5-8,10-14,16,17,19,22-24 and 29 are supported "RTN","VAFCQRY",115,0) ; "RTN","VAFCQRY",116,0) ; At this point only sequence one and two are supported "RTN","VAFCQRY",117,0) ; Variable list "RTN","VAFCQRY",118,0) ; DFN - internal PATIENT (#2) number "RTN","VAFCQRY",119,0) ; CNT - value to be place in PID seq#1 (SET ID) "RTN","VAFCQRY",120,0) ; SEQ - variable consisting of sequence numbers delimited by commas "RTN","VAFCQRY",121,0) ; that will be used to build the message "RTN","VAFCQRY",122,0) ; PID (passed by reference) - array location to place PID segment "RTN","VAFCQRY",123,0) ; result, the array can have existing values when passed. "RTN","VAFCQRY",124,0) ; HL - array that contains the necessary HL variables (init^hlsub) "RTN","VAFCQRY",125,0) ; ERR - array that is used to return an error "RTN","VAFCQRY",126,0) ; "RTN","VAFCQRY",127,0) ;if this is a mismatch a null or """" should be passed in, so that "RTN","VAFCQRY",128,0) ;the ICN will be removed at the site "RTN","VAFCQRY",129,0) ; "RTN","VAFCQRY",130,0) D BLDPID^VAFCQRY1(DFN,CNT,SEQ,.PID,.HL,.ERR) "RTN","VAFCQRY",131,0) Q "RTN","VAFCQRY",132,0) OLD(DFN) ; **902 MVI_4634 (ckn) Return OBX segment to flag a record as "old" "RTN","VAFCQRY",133,0) Q $S($D(^XTMP("MPIF OLD RECORDS",DFN))#2:"OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"OLDER RECORD"_HL("FS")_HL("FS")_"Y",1:"") "RTN","VAFCSB") 0^4^B50707887^B45868659 "RTN","VAFCSB",1,0) VAFCSB ;BIR/CMC-CONT ADT PROCESSOR TO RETRIGGER A08 or A04 MESSAGES WITH AL/AL (COMMIT/APPLICATION) ACKNOWLEDGEMENTS ; 8/14/18 4:20pm "RTN","VAFCSB",2,0) ;;5.3;Registration;**707,756,825,876,902,926,967**;Aug 13, 1993;Build 3 "RTN","VAFCSB",3,0) ; "RTN","VAFCSB",4,0) ;Reference to $$XAMDT^RAO7UTL1 is supported by IA #4875 "RTN","VAFCSB",5,0) ;Reference to RESUTLS^LRPXAPI is supported by IA #4245 "RTN","VAFCSB",6,0) ; "RTN","VAFCSB",7,0) PV2() ;build pv2 segment "RTN","VAFCSB",8,0) N PV2,LSTA,APPT,VASD,VAIP,VARP,VAROOT "RTN","VAFCSB",9,0) S PV2="" "RTN","VAFCSB",10,0) ;get next outpatient appointment "RTN","VAFCSB",11,0) K ^UTILITY("VASD",$J) S VASD("F")=DT D SDA^VADPT "RTN","VAFCSB",12,0) S APPT=$P($G(^UTILITY("VASD",$J,1,"I")),"^") "RTN","VAFCSB",13,0) I APPT'="" S $P(PV2,HL("FS"),9)=$$HLDATE^HLFNC(APPT) "RTN","VAFCSB",14,0) ;GET LAST ADMISSION DATE "RTN","VAFCSB",15,0) K VAIP S VAIP("D")="LAST",VAIP("M")=0 D IN5^VADPT "RTN","VAFCSB",16,0) ; **825,CR_1184: for PV2-14, it will be re-set as the 15th piece "RTN","VAFCSB",17,0) ; in PV2 segment a few lines below "RTN","VAFCSB",18,0) ; I VAIP(2)="1^ADMISSION" S $P(PV2,HL("FS"),15)=$$HLDATE^HLFNC($P(VAIP(3),"^")) "RTN","VAFCSB",19,0) I VAIP(2)="1^ADMISSION" S $P(PV2,HL("FS"),14)=$$HLDATE^HLFNC($P(VAIP(3),"^")) "RTN","VAFCSB",20,0) ;get last registration "RTN","VAFCSB",21,0) S VAROOT="VARP" "RTN","VAFCSB",22,0) D REG^VADPT "RTN","VAFCSB",23,0) I $D(VARP(1,"I")),$G(VARP(1,"I"))>0 S $P(PV2,HL("FS"),46)=$$HLDATE^HLFNC($P(VARP(1,"I"),"^"),"DT"),$P(PV2,HL("FS"),24)="CR" "RTN","VAFCSB",24,0) ;**756 ^ ONLY RETURN DATE FOR LAST REGISTRATION AS HL7 STANDARD CAN ONLY HAVE DATE "RTN","VAFCSB",25,0) I PV2'="" S PV2="PV2"_HL("FS")_PV2 "RTN","VAFCSB",26,0) Q PV2 "RTN","VAFCSB",27,0) PHARA() ;build obx to show active prescriptions "RTN","VAFCSB",28,0) N RET S RET="" "RTN","VAFCSB",29,0) I '$$PATCH^XPDUTL("PSS*1.0*101") Q RET "RTN","VAFCSB",30,0) N PHARM,DGLIST "RTN","VAFCSB",31,0) S PHARM="" D PROF^PSO52API(DFN,"DGLIST") "RTN","VAFCSB",32,0) I +$G(^TMP($J,"DGLIST",DFN,0))>0 S PHARM="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"ACTIVE PRESCRIPTIONS"_HL("FS")_HL("FS")_"Y" "RTN","VAFCSB",33,0) ;**756 CE added as the data type "RTN","VAFCSB",34,0) Q PHARM "RTN","VAFCSB",35,0) SIG(DFN) ;**876 MVI_3467 (ckn) Build OBX for Self Identified Gender "RTN","VAFCSB",36,0) N SIG,SIGE,SIGTMP,OBX S OBX="" "RTN","VAFCSB",37,0) ;I '$$PATCH^XPDUTL("DG*5.3*876") Q OBX "RTN","VAFCSB",38,0) S DIC=2,DA=DFN,DR=".024",DIQ="SIGTMP",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",39,0) I '$D(SIGTMP) K DA,DR,DIQ Q OBX "RTN","VAFCSB",40,0) S SIG=$G(SIGTMP(2,DFN,DR,"I")),SIGE=$G(SIGTMP(2,DFN,DR,"E")) "RTN","VAFCSB",41,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"SELF ID GENDER"_HL("FS")_HL("FS")_SIG_$E(HL("ECH"),1)_SIGE "RTN","VAFCSB",42,0) K DA,DR,DIC,DIQ "RTN","VAFCSB",43,0) Q OBX "RTN","VAFCSB",44,0) DODF(DFN) ;**902 MVI_4898 (ckn) Build OBX for DOD fields "RTN","VAFCSB",45,0) N DODTMP,DODEB,DODLEB,DODSRC,DODLUPD,DODSRCI,DODSRCE,CS,DODLNAM "RTN","VAFCSB",46,0) N DODFNAM,DODMNAM,DODEBE,DODEBI,DODLEBE,DODLEBI,DODSRCCD "RTN","VAFCSB",47,0) S CS=$E(HL("ECH")),SC=$E(HL("ECH"),4) "RTN","VAFCSB",48,0) S DIC=2,DA=DFN,DR=".352;.353;.354;.355",DIQ="DODTMP",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",49,0) S DODSRCI=$G(DODTMP(2,DFN,.353,"I")),DODSRCE=$G(DODTMP(2,DFN,.353,"E")),DODSRC=HL("Q") "RTN","VAFCSB",50,0) ; **926, Story #3230009 (ckn): Source of Notification moved from set of codes to pointer which is pointing to new Source Of Notification file (#47.76) "RTN","VAFCSB",51,0) I DODSRCE'="" D "RTN","VAFCSB",52,0) . S DODSRCCD=$P($G(^DG(47.76,DODSRCI,0)),"^",2) "RTN","VAFCSB",53,0) . S DODSRC=DODSRCCD_CS_DODSRCE_CS_"L" "RTN","VAFCSB",54,0) I DODSRCE'="" S DODSRC=DODSRCI_CS_DODSRCE_CS_"L" "RTN","VAFCSB",55,0) S DODLUPD=$G(DODTMP(2,DFN,.354,"I")) S DODLUPD=$S(DODLUPD="":HL("Q"),1:$$HLDATE^HLFNC(DODLUPD)) "RTN","VAFCSB",56,0) ;If LAST EDITED BY field(#.355) have value, use it to populate sequence 16 of OBX "RTN","VAFCSB",57,0) ;If LAST EDITED BY field(#.355) does not have value, use DEATH ENTERED BY field(#.352) to populate sequence 16 of OBX "RTN","VAFCSB",58,0) ;If both fields empty, send double quotes in sequence 16 of OBX "RTN","VAFCSB",59,0) S DODLEB=HL("Q") ;Default seq 16 "RTN","VAFCSB",60,0) S DODEBE=$G(DODTMP(2,DFN,.352,"E")),DODEBI=$G(DODTMP(2,DFN,.352,"I")) ;DOD Entered by "RTN","VAFCSB",61,0) S DODLEBE=$G(DODTMP(2,DFN,.355,"E")),DODLEBI=$G(DODTMP(2,DFN,.355,"I")) ;DOD Last Edited By "RTN","VAFCSB",62,0) I DODLEBE'="" D "RTN","VAFCSB",63,0) .S DODLEBE=$$HLNAME^HLFNC(DODLEBE,CS),DODLNAM=$S($P(DODLEBE,CS)="":HL("Q"),1:$P(DODLEBE,CS)),DODFNAM=$S($P(DODLEBE,CS,2)="":HL("Q"),1:$P(DODLEBE,CS,2)),DODMNAM=$S($P(DODLEBE,CS,3)="":HL("Q"),1:$P(DODLEBE,CS,3)) "RTN","VAFCSB",64,0) .S DODLEB=$S(DODLEBI="":HL("Q"),1:DODLEBI)_CS_DODLNAM_CS_DODFNAM_CS_DODMNAM_CS_CS_CS_CS_CS_"USVHA"_SC_SC_"0363"_CS_"L"_CS_CS_CS_"PN"_CS_"VA FACILITY ID"_SC_$P($$SITE^VASITE(),"^",3)_SC_"L" "RTN","VAFCSB",65,0) I DODLEBE="",(DODEBE'="") D "RTN","VAFCSB",66,0) .S DODEBE=$$HLNAME^HLFNC(DODEBE,CS),DODLNAM=$S($P(DODEBE,CS)="":HL("Q"),1:$P(DODEBE,CS)),DODFNAM=$S($P(DODEBE,CS,2)="":HL("Q"),1:$P(DODEBE,CS,2)),DODMNAM=$S($P(DODEBE,CS,3)="":HL("Q"),1:$P(DODEBE,CS,3)) "RTN","VAFCSB",67,0) .S DODLEB=$S(DODEBI="":HL("Q"),1:DODEBI)_CS_DODLNAM_CS_DODFNAM_CS_DODMNAM_CS_CS_CS_CS_CS_"USVHA"_SC_SC_"0363"_CS_"L"_CS_CS_CS_"PN"_CS_"VA FACILITY ID"_SC_$P($$SITE^VASITE(),"^",3)_SC_"L" "RTN","VAFCSB",68,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"DATE OF DEATH DATA"_HL("FS")_HL("FS")_DODSRC_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_"R"_HL("FS")_HL("FS")_HL("FS")_DODLUPD_HL("FS")_HL("FS")_$G(DODLEB) "RTN","VAFCSB",69,0) K DA,DR,DIC,DIQ "RTN","VAFCSB",70,0) Q OBX "RTN","VAFCSB",71,0) ; "RTN","VAFCSB",72,0) DODD(DFN) ;**926, Story #3230009 (ckn): Build OBX for DATE OF DEATH DOCUMENTS "RTN","VAFCSB",73,0) N OBX,DODTMP,DODDI,DODD,DODDE,DODDCD "RTN","VAFCSB",74,0) S CS=$E(HL("ECH")) "RTN","VAFCSB",75,0) S DIC=2,DA=DFN,DR=".357",DIQ="DODTMP",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",76,0) S DODDI=$G(DODTMP(2,DFN,.357,"I")),DODDE=$G(DODTMP(2,DFN,.357,"E")),DODD=HL("Q") "RTN","VAFCSB",77,0) I DODDE'="" D "RTN","VAFCSB",78,0) . S DODDCD=$P($G(^DG(47.75,DODDI,0)),"^",2) "RTN","VAFCSB",79,0) . S DODD=DODDCD_CS_DODDE_CS_"L" "RTN","VAFCSB",80,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"DATE OF DEATH DOCUMENTS"_HL("FS")_HL("FS")_DODD "RTN","VAFCSB",81,0) K DA,DR,DIC,DIQ "RTN","VAFCSB",82,0) Q OBX "RTN","VAFCSB",83,0) ; "RTN","VAFCSB",84,0) DODOPT(DFN) ;**926, Story #3230009 (ckn): Build OBX for DATE OF DEATH OPTION "RTN","VAFCSB",85,0) N OBX,DODOPT,DODOPTE,DODOPTI "RTN","VAFCSB",86,0) S CS=$E(HL("ECH")) "RTN","VAFCSB",87,0) S DIC=2,DA=DFN,DR=".358",DIQ="DODTMP",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",88,0) S DODOPTE=$G(DODTMP(2,DFN,.358,"E")),DODOPTI=$G(DODTMP(2,DFN,.358,"I")),DODOPT=HL("Q") "RTN","VAFCSB",89,0) I DODOPTE'="" S DODOPT=DODOPTI_CS_DODOPTE_CS_"L" "RTN","VAFCSB",90,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"DATE OF DEATH OPTION"_HL("FS")_HL("FS")_DODOPT "RTN","VAFCSB",91,0) K DA,DR,DIC,DIQ "RTN","VAFCSB",92,0) Q OBX "RTN","VAFCSB",93,0) ; "RTN","VAFCSB",94,0) DODDISDT(DFN) ;**926, Story #3230009 (ckn): Build OBX for DATE OF DEATH DISCHARGE DATE "RTN","VAFCSB",95,0) ;Q OBX "RTN","VAFCSB",96,0) ; "RTN","VAFCSB",97,0) DODNTPRV(DFN) ;**926, Story #3230009 (ckn): Build OBX for DATE OF DEATH NOTIFICATION "RTN","VAFCSB",98,0) N OBX,DODNP,STN "RTN","VAFCSB",99,0) S CS=$E(HL("ECH")),STN=$$SITE^VASITE(),DODNP="" "RTN","VAFCSB",100,0) ;Populate notify provider if Date of Death last updated have value "RTN","VAFCSB",101,0) I $$GET1^DIQ(2,DFN_",",.354,"I")'="" S DODNP=$P(STN,"^",3)_CS_$P(STN,"^",2)_CS_"L" "RTN","VAFCSB",102,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"NOTIFY PROVIDER"_HL("FS")_HL("FS")_DODNP "RTN","VAFCSB",103,0) Q OBX "RTN","VAFCSB",104,0) ; "RTN","VAFCSB",105,0) SECLOG(DFN) ;**967, Story #783361 (ckn): Build OBX for Sensitivity information "RTN","VAFCSB",106,0) N OBX,SECLVL,SECLOG "RTN","VAFCSB",107,0) S CS=$E(HL("ECH")),OBX="" "RTN","VAFCSB",108,0) S DA=$O(^DGSL(38.1,"B",DFN,"")) I DA="" Q OBX "RTN","VAFCSB",109,0) S DIC=38.1,DR="2",DIQ="SECLOG",DIQ(0)="I,E,N" D EN^DIQ1 "RTN","VAFCSB",110,0) S SECLVL=$G(SECLOG(38.1,DA,2,"I")) I SECLVL="" Q OBX "RTN","VAFCSB",111,0) S SECLVL=SECLVL_CS_$G(SECLOG(38.1,DA,2,"E"))_CS_"L" "RTN","VAFCSB",112,0) S OBX="OBX"_HL("FS")_HL("FS")_"CE"_HL("FS")_"SECURITY LEVEL"_HL("FS")_HL("FS")_SECLVL_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_HL("FS")_"F" "RTN","VAFCSB",113,0) Q OBX "RTN","VAFCSB",114,0) NAMEOBX(DFN) ;**876,MVI_3453 (mko): Build OBX for Patient .01 and Name Components "RTN","VAFCSB",115,0) N FS "RTN","VAFCSB",116,0) S FS=HL("FS") "RTN","VAFCSB",117,0) Q "OBX"_FS_FS_"CE"_FS_"NAME COMPONENTS"_FS_FS_$$NAMECOMP(DFN,$E(HL("ECH"))) "RTN","VAFCSB",118,0) NAMEERR(DFN) ;**876,MVI_3453 (mko): Build ERR for Patient .01 and Name Components "RTN","VAFCSB",119,0) N CS,SC "RTN","VAFCSB",120,0) S CS=$E(HL("ECH")),SC=$E(HL("ECH"),4) "RTN","VAFCSB",121,0) Q "ERR"_HL("FS")_CS_CS_CS_SC_$$NAMECOMP(DFN,SC) "RTN","VAFCSB",122,0) NAMECOMP(DFN,DELIM) ;**876,MVI_3453 (mko): Return Patient .01 and Name Components "RTN","VAFCSB",123,0) N DIHELP,DIMSG,DIERR,MSG,NC,NCIEN,NCIENS,NCPTR,TARG "RTN","VAFCSB",124,0) S NC=$P($G(^DPT(DFN,0)),"^") "RTN","VAFCSB",125,0) S NCPTR=$P($G(^DPT(DFN,"NAME")),"^") Q:'NCPTR NC "RTN","VAFCSB",126,0) S NCIEN=$$FIND1^DIC(20,"","","`"_NCPTR,"","","MSG") Q:'NCIEN NC "RTN","VAFCSB",127,0) S NCIENS=NCIEN_"," "RTN","VAFCSB",128,0) D GETS^DIQ(20,NCIENS,"1:5","","TARG","MSG") Q:$G(DIERR) NC "RTN","VAFCSB",129,0) S NC=NC_DELIM_TARG(20,NCIENS,1)_DELIM_TARG(20,NCIENS,2)_DELIM_TARG(20,NCIENS,3)_DELIM_TARG(20,NCIENS,5)_DELIM_TARG(20,NCIENS,4) "RTN","VAFCSB",130,0) Q NC "RTN","VAFCSB",131,0) LABE() ;BUILD OBX FOR LAST LAB TEST DATE "RTN","VAFCSB",132,0) N OBX S OBX="" "RTN","VAFCSB",133,0) I '$$PATCH^XPDUTL("LR*5.2*295") Q OBX "RTN","VAFCSB",134,0) N LAB,LAB2,EN "RTN","VAFCSB",135,0) S LAB="" K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"C") "RTN","VAFCSB",136,0) S EN=$O(^TMP("DGLAB",$J,"")) I EN'="" S LAB=$P($G(^TMP("DGLAB",$J,EN)),"^") "RTN","VAFCSB",137,0) K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"A") "RTN","VAFCSB",138,0) S EN=$O(^TMP("DGLAB",$J,"")) I EN'="" S LAB2=$P($G(^TMP("DGLAB",$J,EN)),"^") I LAB2>LAB S LAB=LAB2 "RTN","VAFCSB",139,0) K ^TMP("DGLAB",$J) D RESULTS^LRPXAPI("DGLAB",DFN,"M") "RTN","VAFCSB",140,0) S EN=$O(^TMP("DGLAB",$J,"")) I EN'="" S LAB2=$P($G(^TMP("DGLAB",$J,EN)),"^") I LAB2>LAB S LAB=LAB2 "RTN","VAFCSB",141,0) I LAB'="" D "RTN","VAFCSB",142,0) .S $P(OBX,HL("FS"),2)="TS" ;**756 added the data type "RTN","VAFCSB",143,0) .S $P(OBX,HL("FS"),3)="LAST LAB TEST DATE/TIME" "RTN","VAFCSB",144,0) .S $P(OBX,HL("FS"),11)="F" "RTN","VAFCSB",145,0) .S $P(OBX,HL("FS"),14)=$$HLDATE^HLFNC(LAB) "RTN","VAFCSB",146,0) .S OBX="OBX"_HL("FS")_OBX "RTN","VAFCSB",147,0) Q OBX "RTN","VAFCSB",148,0) RADE() ;BUILD OBX FOR LAST RADIOLOGY TEST DATE "RTN","VAFCSB",149,0) N RET S RET="" "RTN","VAFCSB",150,0) I '$$PATCH^XPDUTL("RA*5.0*76") Q RET "RTN","VAFCSB",151,0) N RAD,RADE "RTN","VAFCSB",152,0) S RAD="",RADE=$$XAMDT^RAO7UTL1(DFN) I +RADE<1 Q RAD "RTN","VAFCSB",153,0) I +RADE>0 D "RTN","VAFCSB",154,0) .S $P(OBX,HL("FS"),2)="TS" ;**756 added the data type "RTN","VAFCSB",155,0) .S $P(RAD,HL("FS"),3)="LAST RADIOLOGY EXAM DATE/TIME" "RTN","VAFCSB",156,0) .S $P(RAD,HL("FS"),11)="F" "RTN","VAFCSB",157,0) .S $P(RAD,HL("FS"),14)=$$HLDATE^HLFNC(RADE) "RTN","VAFCSB",158,0) .S RAD="OBX"_HL("FS")_RAD "RTN","VAFCSB",159,0) Q RAD "RTN","VAFCSB",160,0) PD1() ;BUILD PD1 segment "RTN","VAFCSB",161,0) ;PREFERRED FACILITY -- NOT GOING TO BE PASSED PER IMDQ 9/7/06 "RTN","VAFCSB",162,0) N TEAM,PD1 "RTN","VAFCSB",163,0) S PD1="" "RTN","VAFCSB",164,0) ;S TEAM=$$PREF^DGENPTA(DFN) "RTN","VAFCSB",165,0) ;I TEAM'="" S PD1="PD1"_HL("FS")_HL("FS")_HL("FS")_$$STA^XUAF4(TEAM) "RTN","VAFCSB",166,0) Q PD1 "RTN","VAFCSB",167,0) PV1() ;BUILD PV1 SEGMENT "RTN","VAFCSB",168,0) ;CURRENTLY ADMITTED? "RTN","VAFCSB",169,0) N PV1,VAINDT "RTN","VAFCSB",170,0) S PV1="" "RTN","VAFCSB",171,0) S VAINDT=DT "RTN","VAFCSB",172,0) D INP^VADPT "RTN","VAFCSB",173,0) I $G(VAIN(1))'="" S $P(PV1,HL("FS"),44)=$$HLDATE^HLFNC($P(VAIN(7),"^")),PV1="PV1"_HL("FS")_PV1 "RTN","VAFCSB",174,0) K VAIN "RTN","VAFCSB",175,0) Q PV1 "RTN","VAFCTR") 0^1^B6623304^B5564926 "RTN","VAFCTR",1,0) VAFCTR ;BIR/CMC,ERC,PTD-Monitoring fields for MPI/PD via DG field monitoring ; 1/31/17 11:04am "RTN","VAFCTR",2,0) ;;5.3;Registration;**575,648,653,712,876,902,926,937,944,967**;Aug 13, 1993;Build 3 "RTN","VAFCTR",3,0) Q ; quit if called from the top "RTN","VAFCTR",4,0) ; "RTN","VAFCTR",5,0) MPIPD ; protocol entry point for monitoring fields via DG field monitoring "RTN","VAFCTR",6,0) ; Currently monitoring for fields: "RTN","VAFCTR",7,0) ; 1 ALIAS - .01 of the multiple "RTN","VAFCTR",8,0) ; 2 RACE INFORMATION - .01 of the multiple "RTN","VAFCTR",9,0) ; 6 ETHNICITY INFORMATION - .01 of the multiple "RTN","VAFCTR",10,0) ; 994 MULTIPLE BIRTH INDICATOR "RTN","VAFCTR",11,0) ; .525 POW STAUTS INDICATED? "RTN","VAFCTR",12,0) ; .0906 PSEUDO SSN REASON "RTN","VAFCTR",13,0) ; .121 BAD ADDRESS INDICATOR "RTN","VAFCTR",14,0) ; .133 EMAIL ADDRESS "RTN","VAFCTR",15,0) ; .134 PHONE NUMBER [CELLULAR] "RTN","VAFCTR",16,0) ; .024 SELF IDENTIFIED GENDER **876 "RTN","VAFCTR",17,0) ; 391 TYPE ;**876 "RTN","VAFCTR",18,0) ; 1901 VETERAN Y/N? **876 "RTN","VAFCTR",19,0) ; .323 PERIOD OF SERVICE **876 "RTN","VAFCTR",20,0) ; .352 DEATH ENTERED BY **902 MVI_4735 (jfw) "RTN","VAFCTR",21,0) ; .353 SOURCE OF NOTIFICATION **902 MVI_4735 (jfw) "RTN","VAFCTR",22,0) ; .354 DATE OF DEATH LAST UPDATED **902 MVI_4735 (jfw) "RTN","VAFCTR",23,0) ; .355 LAST EDITED BY **902 MVI_4735 (jfw) "RTN","VAFCTR",24,0) ; .357 SUPPORTING DOCUMENT TYPE **926 STORY 323008 (jfw) "RTN","VAFCTR",25,0) ; .2405 PREFERRED NAME **937 STORY 445457 [Sub-Story 455414] (jfw) "RTN","VAFCTR",26,0) ; .0931 PLACE OF BIRTH COUNTRY **944 STORY 504382 [Sub-Story 513042] (jfw) "RTN","VAFCTR",27,0) ; .0932 PLACE OF BIRTH PROVINCE **944 STORY 504382 [Sub-Story 513042] (jfw) "RTN","VAFCTR",28,0) ; "RTN","VAFCTR",29,0) ;**967 STORY #783361 Sensitivity (jfw) "RTN","VAFCTR",30,0) ; DG SECURITY LOG File #38.1 monitored field: "RTN","VAFCTR",31,0) ; Note: .01 is DINUMED to the PATIENT File #2 "RTN","VAFCTR",32,0) ; 2 SECURITY LEVEL "RTN","VAFCTR",33,0) ; "RTN","VAFCTR",34,0) N MVIRSLT "RTN","VAFCTR",35,0) I $G(DGFILE)'=2&($G(DGFILE)'=2.01)&($G(DGFILE)'=2.02)&($G(DGFILE)'=2.06)&($G(DGFILE)'=38.1) Q "RTN","VAFCTR",36,0) S DGFIELD=$G(DGFIELD) "RTN","VAFCTR",37,0) ;I DGFIELD'=.01&(DGFIELD'=994)&(DGFIELD'=.525)&(DGFIELD'=.0906)&(DGFIELD'=.121)&(DGFIELD'=.133)&(DGFIELD'=.134)&(DGFIELD'=391)&(DGFIELD'=1901)&(DGFIELD'=.323)&(DGFIELD'=.024) Q "RTN","VAFCTR",38,0) ;**902 MVI_4735 (jfw) Add 4 new fields to list (Break apart long If line above) "RTN","VAFCTR",39,0) S MVIRSLT=(DGFIELD'=.01)&(DGFIELD'=994)&(DGFIELD'=.525)&(DGFIELD'=.0906)&(DGFIELD'=.121)&(DGFIELD'=.133) "RTN","VAFCTR",40,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.134)&(DGFIELD'=391)&(DGFIELD'=1901)&(DGFIELD'=.323)&(DGFIELD'=.024) "RTN","VAFCTR",41,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.352)&(DGFIELD'=.353)&(DGFIELD'=.354)&(DGFIELD'=.355)&(DGFIELD'=.357) "RTN","VAFCTR",42,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.2405)&(DGFIELD'=.0931)&(DGFIELD'=.0932)&(DGFIELD'=2) "RTN","VAFCTR",43,0) Q:(MVIRSLT) "RTN","VAFCTR",44,0) I $T(AVAFC^VAFCDD01)="" Q "RTN","VAFCTR",45,0) ;The fields below are not multiples "RTN","VAFCTR",46,0) ;I (DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133)!(DGFIELD=.134)!(DGFIELD=.024)!(DGFIELD=391)!(DGFIELD=1901)!(DGFIELD=.323) S VAFCF=DGFIELD_";" D AVAFC^VAFCDD01(DGDA) "RTN","VAFCTR",47,0) ;**902 MVI_4735 (jfw) Add 4 new fields to list (Break apart long If line above) "RTN","VAFCTR",48,0) S MVIRSLT=(DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133) "RTN","VAFCTR",49,0) S MVIRSLT=MVIRSLT!(DGFIELD=.134)!(DGFIELD=.024)!(DGFIELD=391)!(DGFIELD=1901)!(DGFIELD=.323) "RTN","VAFCTR",50,0) S MVIRSLT=MVIRSLT!(DGFIELD=.352)!(DGFIELD=.353)!(DGFIELD=.354)!(DGFIELD=.355)!(DGFIELD=.357) "RTN","VAFCTR",51,0) S MVIRSLT=MVIRSLT!(DGFIELD=.2405)!(DGFIELD=.0931)!(DGFIELD=.0932) "RTN","VAFCTR",52,0) I MVIRSLT S VAFCF=DGFIELD_";" D AVAFC^VAFCDD01(DGDA) "RTN","VAFCTR",53,0) ;The fields below ARE multiples "RTN","VAFCTR",54,0) I DGFILE=2.01 S VAFCF="1;" D AVAFC^VAFCDD01(DGDA(1)) ;ALIAS "RTN","VAFCTR",55,0) I DGFILE=2.02 S VAFCF="2.02,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;RACE INFORMATION "RTN","VAFCTR",56,0) I DGFILE=2.06 S VAFCF="2.06,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;ETHNICITY INFORMATION "RTN","VAFCTR",57,0) ;Process field for different File **967 (jfw) "RTN","VAFCTR",58,0) I DGFILE=38.1 S VAFCF="38.1,2;" D AVAFC^VAFCDD01(DGDA) ;Sensitivity Info "RTN","VAFCTR",59,0) Q "VER") 8.0^22.2 "^DD",38.1,38.1,2,0) SECURITY LEVEL^RSX^0:NON-SENSITIVE;1:SENSITIVE;^0;2^Q "^DD",38.1,38.1,2,1,0) ^.1^^-1 "^DD",38.1,38.1,2,1,1,0) 38.1^ABUL^MUMPS "^DD",38.1,38.1,2,1,1,1) Q "^DD",38.1,38.1,2,1,1,2) I +X,'+$P(^DGSL(38.1,DA,0),U,2) D BULTIN^DGSEC1 "^DD",38.1,38.1,2,1,2,0) 38.1^ANS^MUMPS "^DD",38.1,38.1,2,1,2,1) I '+$P(^DGSL(38.1,DA,0),U,2) S ^DGSL(38.1,"ANS",DA)="" "^DD",38.1,38.1,2,1,2,2) K ^DGSL(38.1,"ANS",DA) "^DD",38.1,38.1,2,3) Select the code that specifies if the patient's record should be marked as sensitive. "^DD",38.1,38.1,2,21,0) ^.001^2^2^3180815^^^^ "^DD",38.1,38.1,2,21,1,0) This field contains a 1 if the patient record is presently listed as "^DD",38.1,38.1,2,21,2,0) sensitive or a 0 if the patient's record is not currently sensitive. "^DD",38.1,38.1,2,"DT") 3180815 "BLD",3351,6) ^849 **END** **END**