Released DG*5.3*937 SEQ #822 Extracted from mail message **KIDS**:DG*5.3*937^ **INSTALL NAME** DG*5.3*937 "BLD",3220,0) DG*5.3*937^REGISTRATION^0^3170414^y "BLD",3220,1,0) ^^3^3^3170308^ "BLD",3220,1,1,0) MASTER VETERAN INDEX VISTA ENHANCEMENTS - 'PREFERRED NAME' "BLD",3220,1,2,0) Refer to patch DG*5.3*937 in the FORUM Patch Module for a complete "BLD",3220,1,3,0) description. "BLD",3220,4,0) ^9.64PA^2^1 "BLD",3220,4,2,0) 2 "BLD",3220,4,2,2,0) ^9.641^2^1 "BLD",3220,4,2,2,2,0) PATIENT (File-top level) "BLD",3220,4,2,2,2,1,0) ^9.6411^.2405^1 "BLD",3220,4,2,2,2,1,.2405,0) PREFERRED NAME "BLD",3220,4,2,222) y^n^p^^^^n^^n "BLD",3220,4,2,224) "BLD",3220,4,"APDD",2,2) "BLD",3220,4,"APDD",2,2,.2405) "BLD",3220,4,"B",2,2) "BLD",3220,6.3) 3 "BLD",3220,"KRN",0) ^9.67PA^779.2^20 "BLD",3220,"KRN",.4,0) .4 "BLD",3220,"KRN",.401,0) .401 "BLD",3220,"KRN",.402,0) .402 "BLD",3220,"KRN",.403,0) .403 "BLD",3220,"KRN",.5,0) .5 "BLD",3220,"KRN",.84,0) .84 "BLD",3220,"KRN",3.6,0) 3.6 "BLD",3220,"KRN",3.8,0) 3.8 "BLD",3220,"KRN",9.2,0) 9.2 "BLD",3220,"KRN",9.8,0) 9.8 "BLD",3220,"KRN",9.8,"NM",0) ^9.68A^4^4 "BLD",3220,"KRN",9.8,"NM",1,0) VAFCQRY1^^0^B86325384 "BLD",3220,"KRN",9.8,"NM",2,0) VAFCTR^^0^B5086343 "BLD",3220,"KRN",9.8,"NM",3,0) VAFCPDAT^^0^B63381582 "BLD",3220,"KRN",9.8,"NM",4,0) VAFCPDT2^^0^B28878305 "BLD",3220,"KRN",9.8,"NM","B","VAFCPDAT",3) "BLD",3220,"KRN",9.8,"NM","B","VAFCPDT2",4) "BLD",3220,"KRN",9.8,"NM","B","VAFCQRY1",1) "BLD",3220,"KRN",9.8,"NM","B","VAFCTR",2) "BLD",3220,"KRN",19,0) 19 "BLD",3220,"KRN",19.1,0) 19.1 "BLD",3220,"KRN",101,0) 101 "BLD",3220,"KRN",409.61,0) 409.61 "BLD",3220,"KRN",771,0) 771 "BLD",3220,"KRN",779.2,0) 779.2 "BLD",3220,"KRN",870,0) 870 "BLD",3220,"KRN",8989.51,0) 8989.51 "BLD",3220,"KRN",8989.52,0) 8989.52 "BLD",3220,"KRN",8994,0) 8994 "BLD",3220,"KRN","B",.4,.4) "BLD",3220,"KRN","B",.401,.401) "BLD",3220,"KRN","B",.402,.402) "BLD",3220,"KRN","B",.403,.403) "BLD",3220,"KRN","B",.5,.5) "BLD",3220,"KRN","B",.84,.84) "BLD",3220,"KRN","B",3.6,3.6) "BLD",3220,"KRN","B",3.8,3.8) "BLD",3220,"KRN","B",9.2,9.2) "BLD",3220,"KRN","B",9.8,9.8) "BLD",3220,"KRN","B",19,19) "BLD",3220,"KRN","B",19.1,19.1) "BLD",3220,"KRN","B",101,101) "BLD",3220,"KRN","B",409.61,409.61) "BLD",3220,"KRN","B",771,771) "BLD",3220,"KRN","B",779.2,779.2) "BLD",3220,"KRN","B",870,870) "BLD",3220,"KRN","B",8989.51,8989.51) "BLD",3220,"KRN","B",8989.52,8989.52) "BLD",3220,"KRN","B",8994,8994) "BLD",3220,"QDEF") ^^^^NO^^^^NO^^YES "BLD",3220,"QUES",0) ^9.62^^ "BLD",3220,"REQB",0) ^9.611^3^3 "BLD",3220,"REQB",1,0) DG*5.3*874^2 "BLD",3220,"REQB",2,0) DG*5.3*876^2 "BLD",3220,"REQB",3,0) DG*5.3*926^2 "BLD",3220,"REQB","B","DG*5.3*874",1) "BLD",3220,"REQB","B","DG*5.3*876",2) "BLD",3220,"REQB","B","DG*5.3*926",3) "FIA",2) PATIENT "FIA",2,0) ^DPT( "FIA",2,0,0) 2I "FIA",2,0,1) y^n^p^^^^n^^n "FIA",2,0,10) "FIA",2,0,11) "FIA",2,0,"RLRO") "FIA",2,0,"VR") 5.3^DG "FIA",2,2) 1 "FIA",2,2,.2405) "IX",2,2,"AVAFC2405",0) 2^AVAFC2405^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC2405",.1,0) ^^5^5^3170126 "IX",2,2,"AVAFC2405",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC2405",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC2405",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC2405",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC2405",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC2405",1) D FC^DGFCPROT(.DA,2,.2405,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC2405",2) D FC^DGFCPROT(.DA,2,.2405,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC2405",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC2405",11.1,1,0) 1^F^2^.2405^^^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) 937^3170414 "PKG",5,22,1,"PAH",1,1,0) ^^3^3^3170414 "PKG",5,22,1,"PAH",1,1,1,0) MASTER VETERAN INDEX VISTA ENHANCEMENTS - 'PREFERRED NAME' "PKG",5,22,1,"PAH",1,1,2,0) Refer to patch DG*5.3*937 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") 4 "RTN","VAFCPDAT") 0^3^B63381582^B63310519 "RTN","VAFCPDAT",1,0) VAFCPDAT ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ; 7/12/16 11:11am "RTN","VAFCPDAT",2,0) ;;5.3;Registration;**333,414,474,505,707,712,837,863,876,902,926,937**;Aug 13, 1993;Build 3 "RTN","VAFCPDAT",3,0) ;Registration has IA #3299 for MPI/PD to call START^VAFCPDAT "RTN","VAFCPDAT",4,0) ; "RTN","VAFCPDAT",5,0) ;variable DFN is not NEWed or KILLed in this routine as that variable is passed in "RTN","VAFCPDAT",6,0) ; "RTN","VAFCPDAT",7,0) MAIN ; Entry point with device call "RTN","VAFCPDAT",8,0) S NOTRPC=1 "RTN","VAFCPDAT",9,0) K ZTSAVE S ZTSAVE("DFN")="" "RTN","VAFCPDAT",10,0) D EN^XUTMDEVQ("START^VAFCPDAT","Print MPI/PD Patient Data",.ZTSAVE) "RTN","VAFCPDAT",11,0) K NOTRPC "RTN","VAFCPDAT",12,0) Q "RTN","VAFCPDAT",13,0) ; "RTN","VAFCPDAT",14,0) START ;Entry point without device call, used for RPC calls "RTN","VAFCPDAT",15,0) N X S X="MPIF001" X ^%ZOSF("TEST") I '$T W !,"MPI not installed." G QUIT ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",16,0) S $P(LN,"=",80)="",$P(LN2,"=",60)="",QFLG=0 "RTN","VAFCPDAT",17,0) D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12)) "RTN","VAFCPDAT",18,0) S SITE=$$SITE^VASITE(),SITENAM=$P(SITE,"^",2),SITENUM=$P(SITE,"^",3),SITEIEN=$P(SITE,"^") "RTN","VAFCPDAT",19,0) I +DFN<0 D Q "RTN","VAFCPDAT",20,0) .I $D(NOTRPC) W @IOF,!," " "RTN","VAFCPDAT",21,0) .W !,"ICN ",$G(ICN)," does not exist at ",SITENAM,"." "RTN","VAFCPDAT",22,0) .W !,"Search date: ",HDT,!,LN "RTN","VAFCPDAT",23,0) S DIC=2,DR=".01;.02;.03;.09;.111;.112;.113;.114;.115;.1112;.131;.313;.351;994;.0907;.0906;.121;.1171;.1172;.1173;.024;.352;.353;.354;.355;.357;.358;.2405",DA=DFN,DIQ(0)="EI",DIQ="DNODE" ;**707,712,863,876 "RTN","VAFCPDAT",24,0) N NAME,SSN,DOB,SEX,CLAIM,DOD,ICN,STR1,STR2,STR3,CTY,ST,ZIP,PHN,MBI,SSNVER,PREAS,BAI,TIN,FIN,COUNTRY,CCODE,CNAME,PROVINCE,POSTCODE,SIGEN ;**707,712,837,863,876 "RTN","VAFCPDAT",25,0) N DODD,DODENTBY,DODSRC,DODLUPD,DODLEBY,DODOPT ;**926 Story 323009 (ckn) "RTN","VAFCPDAT",26,0) D EN^DIQ1 K DIC,DR,DA,DIQ "RTN","VAFCPDAT",27,0) S NAME=$G(DNODE(2,DFN,.01,"E")),SSN=$G(DNODE(2,DFN,.09,"E")) "RTN","VAFCPDAT",28,0) S DOB=$$FMTE^XLFDT($G(DNODE(2,DFN,.03,"I"))) "RTN","VAFCPDAT",29,0) S MBI=$G(DNODE(2,DFN,994,"I")),MBI=$S(MBI="Y":"YES",MBI="N":"NO",1:"NULL") ;**707 "RTN","VAFCPDAT",30,0) S SEX=$G(DNODE(2,DFN,.02,"E")),SIGEN=$G(DNODE(2,DFN,.024,"E")),DOD=$G(DNODE(2,DFN,.351,"E")) ;**876 - MVI_3432 (cml) "RTN","VAFCPDAT",31,0) S CLAIM=$G(DNODE(2,DFN,.313,"E")) S:CLAIM="" CLAIM="None" "RTN","VAFCPDAT",32,0) S BAI=$G(DNODE(2,DFN,.121,"E")) ;**712 "RTN","VAFCPDAT",33,0) S STR1=$G(DNODE(2,DFN,.111,"E")),STR2=$G(DNODE(2,DFN,.112,"E")),STR3=$G(DNODE(2,DFN,.113,"E")) "RTN","VAFCPDAT",34,0) S CTY=$G(DNODE(2,DFN,.114,"E")),ST=$G(DNODE(2,DFN,.115,"E")),ZIP=$G(DNODE(2,DFN,.1112,"E")) "RTN","VAFCPDAT",35,0) S COUNTRY=$G(DNODE(2,DFN,.1173,"I")),(CCODE,CNAME)="" I COUNTRY]"" S CCODE=$$GET1^DIQ(779.004,+COUNTRY_",",.01),CNAME=$$GET1^DIQ(779.004,+COUNTRY_",",1.3) ;**863 - MVI_1902 (ptd) "RTN","VAFCPDAT",36,0) S PROVINCE=$G(DNODE(2,DFN,.1171,"E")),POSTCODE=$G(DNODE(2,DFN,.1172,"E")) "RTN","VAFCPDAT",37,0) S PHN=$G(DNODE(2,DFN,.131,"E")) "RTN","VAFCPDAT",38,0) S SSNVER=$G(DNODE(2,DFN,.0907,"E")) ;**707 "RTN","VAFCPDAT",39,0) S PREAS=$G(DNODE(2,DFN,.0906,"E")) ;**707 "RTN","VAFCPDAT",40,0) S MNODE=$$MPINODE^MPIFAPI(DFN) I +MNODE=-1 S MNODE="^^^^^^^^" "RTN","VAFCPDAT",41,0) S (ICN,SCN,SCORE,SCRDT,DIFF,TIN,FIN)="" ;**837, MVI_883 "RTN","VAFCPDAT",42,0) S ICN=$$GETICN^MPIF001(DFN) S:(+ICN=-1) ICN="None" ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",43,0) ;**926 - Story 323009 (ckn): DOD fields "RTN","VAFCPDAT",44,0) I DOD'="" D "RTN","VAFCPDAT",45,0) . S DODENTBY=$G(DNODE(2,DFN,.352,"E")) ;Date of Death Entered By "RTN","VAFCPDAT",46,0) . S DODSRC=$G(DNODE(2,DFN,.353,"E")) ;Date of Death Source of Notification "RTN","VAFCPDAT",47,0) . S DODLUPD=$G(DNODE(2,DFN,.354,"E")) ;Date of Death Last Updated "RTN","VAFCPDAT",48,0) . S DODLEBY=$G(DNODE(2,DFN,.355,"E")) ;Date of Death Last Edited By "RTN","VAFCPDAT",49,0) . S DODD=$G(DNODE(2,DFN,.357,"E")) ;Date of Death Supporting Document Type "RTN","VAFCPDAT",50,0) . S DODOPT=$G(DNODE(2,DFN,.358,"E")) ;Date of Death Option Used "RTN","VAFCPDAT",51,0) ;S CMOR=$$GET1^DIQ(4,+$P($G(MNODE),"^",3)_",",.01) S:CMOR="" CMOR="None" ;removed for **837, MVI_918 "RTN","VAFCPDAT",52,0) I $E(ICN,1,3)=SITENUM S GOT=0 D "RTN","VAFCPDAT",53,0) . I $P($G(MNODE),"^",4)=""!('$D(^DPT("AICNL",1,DFN))) S ICN=ICN_"**" "RTN","VAFCPDAT",54,0) S TIN=$P($G(MNODE),"^",8),FIN=$P($G(MNODE),"^",9) ;**837, MVI_883 "RTN","VAFCPDAT",55,0) ; "RTN","VAFCPDAT",56,0) I $D(NOTRPC) W @IOF,! "RTN","VAFCPDAT",57,0) W !,"MPI/PD Data for: ",NAME," (DFN #",DFN,")" "RTN","VAFCPDAT",58,0) ; check for patient sensitivity and user security "RTN","VAFCPDAT",59,0) N RESULT,RGSENS,SENSTV,DA,DR,DIC,DIQ,VAFCSEN "RTN","VAFCPDAT",60,0) D PTSEC^DGSEC4(.RESULT,DFN,0,"MPI/PD Patient Inquiry^MPI/PD Patient Inquiry") "RTN","VAFCPDAT",61,0) I RESULT(1)=-1 W !!,"Access denied: Required parameters not defined" G QUIT "RTN","VAFCPDAT",62,0) I RESULT(1)>0 W ?50,"***PATIENT MARKED SENSITIVE***" "RTN","VAFCPDAT",63,0) I RESULT(1)=3 W !!,"Access not allowed on your own PATIENT (#2) file entry" G QUIT "RTN","VAFCPDAT",64,0) I RESULT(1)=4 W !!,"Access denied: Your SSN is not defined" G QUIT "RTN","VAFCPDAT",65,0) I RESULT(1)<3 D "RTN","VAFCPDAT",66,0) . I RESULT(1)=1 D NOTICE^DGSEC4(.VAFCSEN,DFN,"RPC - VAFC REMOTE PDAT FROM THE MPI^MPI/PD Patient Inquiry (Remote)",2) ;IA #3027 "RTN","VAFCPDAT",67,0) . I RESULT(1)=2 D NOTICE^DGSEC4(.VAFCSEN,DFN,"RPC - VAFC REMOTE PDAT FROM THE MPI^MPI/PD Patient Inquiry (Remote)",3) ;IA #3027 "RTN","VAFCPDAT",68,0) W !,"Printed ",HDT," at ",SITENAM,!,LN "RTN","VAFCPDAT",69,0) S $Y=$Y+1 "RTN","VAFCPDAT",70,0) ;next 7 lines modified for **707 "RTN","VAFCPDAT",71,0) W !,"ICN : ",ICN ;CMOR removed **837, MVI_918 "RTN","VAFCPDAT",72,0) W !,"SSN : ",SSN "RTN","VAFCPDAT",73,0) I SSNVER]"" W !?9,"SSN Verification Status: ",SSNVER "RTN","VAFCPDAT",74,0) I SSNVER="",PREAS]"" W !?9,"Pseudo SSN Reason: ",PREAS "RTN","VAFCPDAT",75,0) I SSNVER]"",PREAS]"" W !?9,"Pseudo SSN Reason : ",PREAS "RTN","VAFCPDAT",76,0) W !,"Sex : ",SEX "RTN","VAFCPDAT",77,0) W !,"Claim #: ",CLAIM "RTN","VAFCPDAT",78,0) W !,"Date of Birth: ",DOB "RTN","VAFCPDAT",79,0) ;**926 - Story 323009 (ckn): DOD fields "RTN","VAFCPDAT",80,0) I DOD]"" D "RTN","VAFCPDAT",81,0) . W !,"Date of Death: ",DOD "RTN","VAFCPDAT",82,0) . I DODENTBY]"" W !,?15,"Entered By: ",?42,DODENTBY "RTN","VAFCPDAT",83,0) . I DODSRC]"" W !,?15,"Source of Notification: ",?42,DODSRC "RTN","VAFCPDAT",84,0) . I DODLUPD]"" W !,?15,"Last Updated: ",?42,DODLUPD "RTN","VAFCPDAT",85,0) . I DODLEBY]"" W !,?15,"Last Edited By: ",?42,DODLEBY "RTN","VAFCPDAT",86,0) . I DODD]"" W !,?15,"Supporting Document Type: ",?42,DODD "RTN","VAFCPDAT",87,0) . I DODOPT]"" W !,?15,"Option Used: ",?42,DODOPT "RTN","VAFCPDAT",88,0) ;I DOD]"" W !,"Date of Death: ",DOD "RTN","VAFCPDAT",89,0) I MBI]"" W !,"Multiple Birth Indicator: ",MBI ;**707 "RTN","VAFCPDAT",90,0) I TIN]"" W !,"DoD Temporary ID Number : ",TIN ;**837, MVI_883 "RTN","VAFCPDAT",91,0) I FIN]"" W !,"DoD Foreign ID Number : ",FIN ;**837, MVI_883 "RTN","VAFCPDAT",92,0) W !,"Address:" I BAI'="" W " (Bad Address Indicator: ",BAI,")" "RTN","VAFCPDAT",93,0) I STR1'="" W !?9,STR1 "RTN","VAFCPDAT",94,0) I STR2'="" W !?9,STR2 "RTN","VAFCPDAT",95,0) I STR3'="" W !?9,STR3 "RTN","VAFCPDAT",96,0) I COUNTRY=""!(CCODE="USA") D ;USA Address **863 - MVI_1902 (ptd) "RTN","VAFCPDAT",97,0) .I CTY]"" W !?9,$E(CTY,1,20)_", "_$G(ST)_" "_$G(ZIP) "RTN","VAFCPDAT",98,0) I COUNTRY]"",CCODE'="USA" D ;Foreign Address "RTN","VAFCPDAT",99,0) .I CTY]""!(PROVINCE]"")!(POSTCODE]"") D "RTN","VAFCPDAT",100,0) ..I PROVINCE]"" W !?9,CTY_", "_PROVINCE_" ("_CNAME_") "_POSTCODE "RTN","VAFCPDAT",101,0) ..I PROVINCE="" W !?9,CTY_", "_"("_CNAME_") "_POSTCODE "RTN","VAFCPDAT",102,0) I PHN'="" W !,"Phone #: ",PHN "RTN","VAFCPDAT",103,0) I SIGEN]"" W !,"Self-Identified Gender Identity: ",SIGEN ;**876 - MVI_3432 (cml) **902 - MVI_4730 (cml) "RTN","VAFCPDAT",104,0) I $G(IOSL)<30&($E(IOST,1,2)="C-") D "RTN","VAFCPDAT",105,0) .I $Y>23 D "RTN","VAFCPDAT",106,0) ..S DIR(0)="E" D D ^DIR K DIR I 'Y S QFLG=1 "RTN","VAFCPDAT",107,0) ...S SS=22-$Y F JJ=1:1:SS W ! "RTN","VAFCPDAT",108,0) ..S $Y=0 "RTN","VAFCPDAT",109,0) I QFLG=1 G QUIT "RTN","VAFCPDAT",110,0) ; "RTN","VAFCPDAT",111,0) TF ;List Treating Facilities for this patient "RTN","VAFCPDAT",112,0) D TFHDR "RTN","VAFCPDAT",113,0) K TFARR "RTN","VAFCPDAT",114,0) S TF=0 F S TF=$O(^DGCN(391.91,"APAT",DFN,TF)) Q:'TF D "RTN","VAFCPDAT",115,0) .S TFIEN=$O(^DGCN(391.91,"APAT",DFN,TF,0)) "RTN","VAFCPDAT",116,0) . S DIC="^DGCN(391.91,",DR=".02;.03;.07",DA=TFIEN,DIQ(0)="EI",DIQ="TFDATA" "RTN","VAFCPDAT",117,0) . D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDAT",118,0) . S INST="",STATION="" "RTN","VAFCPDAT",119,0) . S INST=$G(TFDATA(391.91,TFIEN,.02,"I")) "RTN","VAFCPDAT",120,0) . I INST'="" D "RTN","VAFCPDAT",121,0) .. S DIC=4,DR="99",DA=INST,DIQ(0)="E",DIQ="STA" "RTN","VAFCPDAT",122,0) .. D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDAT",123,0) .. S STATION=$G(STA(4,INST,99,"E")) "RTN","VAFCPDAT",124,0) . S TFNM=$G(TFDATA(391.91,TFIEN,.02,"E")) "RTN","VAFCPDAT",125,0) . S LSTDT=$G(TFDATA(391.91,TFIEN,.03,"I")) S:LSTDT="" LSTDT="none found" "RTN","VAFCPDAT",126,0) . S LSTSORT=9999999 "RTN","VAFCPDAT",127,0) . I +LSTDT S LSTSORT=9999999-LSTDT,LSTDT=$$FMTE^XLFDT($E(LSTDT,1,12)) "RTN","VAFCPDAT",128,0) . S REACODE=$G(TFDATA(391.91,TFIEN,.07,"E")) S REASON="none found" "RTN","VAFCPDAT",129,0) . I REACODE'="" D "RTN","VAFCPDAT",130,0) .. S DIC="^VAT(391.72,",DIC(0)="Z",X=REACODE D ^DIC K DIC,X "RTN","VAFCPDAT",131,0) .. S REASON=$P($G(Y(0)),"^",4) "RTN","VAFCPDAT",132,0) . S TFARR(LSTSORT,TFNM)=TFIEN_"^"_REASON_"^"_$G(STATION)_"^"_LSTDT "RTN","VAFCPDAT",133,0) I '$D(TFARR) W !,"No Treating Facilities found." G SUB "RTN","VAFCPDAT",134,0) S LSTSORT=0 F S LSTSORT=$O(TFARR(LSTSORT)) Q:'LSTSORT D G:QFLG QUIT "RTN","VAFCPDAT",135,0) .S TFNM="" F S TFNM=$O(TFARR(LSTSORT,TFNM)) Q:TFNM="" D Q:QFLG "RTN","VAFCPDAT",136,0) ..S REASON=$P(TFARR(LSTSORT,TFNM),"^",2) "RTN","VAFCPDAT",137,0) ..S STATION=$P(TFARR(LSTSORT,TFNM),"^",3) "RTN","VAFCPDAT",138,0) ..S LSTDT=$P(TFARR(LSTSORT,TFNM),"^",4) "RTN","VAFCPDAT",139,0) ..I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDAT",140,0) ...S LNQ=22 D SS Q:QFLG "RTN","VAFCPDAT",141,0) ...W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D TFHDR "RTN","VAFCPDAT",142,0) ..W !,$E(TFNM,1,20),?22,$G(STATION),?32,LSTDT,?54,REASON "RTN","VAFCPDAT",143,0) SUB ;removed listing of subscribers for RG*1.0*23 "RTN","VAFCPDAT",144,0) HIS ;find ICN history "RTN","VAFCPDAT",145,0) I '$O(^DPT(DFN,"MPIFHIS",0)) G CONT "RTN","VAFCPDAT",146,0) ; "RTN","VAFCPDAT",147,0) I $Y+4>IOSL&($E(IOST,1,2)="C-") D G:QFLG QUIT "RTN","VAFCPDAT",148,0) .S LNQ=22 D SS Q:QFLG "RTN","VAFCPDAT",149,0) .W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDAT",150,0) D ICNHDR "RTN","VAFCPDAT",151,0) S HIS=0 F S HIS=$O(^DPT(DFN,"MPIFHIS",HIS)) Q:'HIS D G:QFLG QUIT "RTN","VAFCPDAT",152,0) .S DIC=2,DR="992",DR(2.0992)=".01;1;3",DA=DFN,DA(2.0992)=HIS ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",153,0) .S DIQ(0)="E",DIQ="HISNODE" "RTN","VAFCPDAT",154,0) .D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDAT",155,0) .S HISICN=$G(HISNODE(2.0992,HIS,.01,"E")) "RTN","VAFCPDAT",156,0) .S HISCHK=$G(HISNODE(2.0992,HIS,1,"E")) ;**863 - MVI_2351 (ptd) history checksum "RTN","VAFCPDAT",157,0) .S HFULLICN=HISICN_$S(HISCHK]"":"V"_HISCHK,1:"") ;**863 - MVI_2351 (ptd) History full ICN "RTN","VAFCPDAT",158,0) .S HISDT=$G(HISNODE(2.0992,HIS,3,"E")) "RTN","VAFCPDAT",159,0) .I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDAT",160,0) ..S LNQ=22 D SS Q:QFLG "RTN","VAFCPDAT",161,0) ..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D ICNHDR "RTN","VAFCPDAT",162,0) .W !,HFULLICN I HISDT]"" W " - changed ",HISDT ;**863 - MVI_2351 (ptd) "RTN","VAFCPDAT",163,0) ; "RTN","VAFCPDAT",164,0) CONT ;Continue to VAFCPDT2 for extended data "RTN","VAFCPDAT",165,0) ;D CMORHIS^VAFCPDT2 "RTN","VAFCPDAT",166,0) ;CMOR History removed, called changed to EXT^VAFCPDT2 **837, MVI_918 "RTN","VAFCPDAT",167,0) D EXT^VAFCPDT2 "RTN","VAFCPDAT",168,0) DONE ; "RTN","VAFCPDAT",169,0) I QFLG G QUIT "RTN","VAFCPDAT",170,0) I ($E(IOST,1,2)="C-") S LNQ=24 D SS "RTN","VAFCPDAT",171,0) ; "RTN","VAFCPDAT",172,0) QUIT ; "RTN","VAFCPDAT",173,0) K %,CMOR,DIC,DIR,DIRUT,DNODE,GOT,HDT,HFULLICN,HIS,HISCHK,HISDT,HISICN,JJ,LIEN "RTN","VAFCPDAT",174,0) K LINST,LN,LSTDT,MNODE,REACODE,REASON,SCN,SCORE,SITE,SITEIEN,SITENAM,SITENUM "RTN","VAFCPDAT",175,0) K SS,SUBN,SUBARR,TERM,TERMDT,TF,TFARR,TFDATA,TFIEN,TFNM,Y,D,CHG,CHGNODE "RTN","VAFCPDAT",176,0) K HISNODE,DIFF,INST,RGDFN,SCRDT,STATION,STA,LN2,NAME,LSTSORT,LNQ,QFLG,MBI "RTN","VAFCPDAT",177,0) Q "RTN","VAFCPDAT",178,0) TFHDR ; "RTN","VAFCPDAT",179,0) W !!,"Treating Facilities:",?22,"Station:",?32,"DT Last Treated",?54,"Event Reason" "RTN","VAFCPDAT",180,0) W !,"--------------------",?22,"--------",?32,"---------------",?54,"------------" "RTN","VAFCPDAT",181,0) Q "RTN","VAFCPDAT",182,0) ICNHDR W !!,"ICN History:",!,"------------" "RTN","VAFCPDAT",183,0) Q "RTN","VAFCPDAT",184,0) ; "RTN","VAFCPDAT",185,0) SS S DIR(0)="E" D D ^DIR K DIR I 'Y S QFLG=1 "RTN","VAFCPDAT",186,0) .S SS=LNQ-$Y F JJ=1:1:SS W ! "RTN","VAFCPDAT",187,0) Q "RTN","VAFCPDT2") 0^4^B28878305^B28085527 "RTN","VAFCPDT2",1,0) VAFCPDT2 ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ; 1/6/11 3:57pm "RTN","VAFCPDT2",2,0) ;;5.3;Registration;**414,505,627,697,797,876,937**;Aug 13, 1993;Build 3 "RTN","VAFCPDT2",3,0) ;Reference to ^MPIF(984.9,"C" supported by IA #3298 "RTN","VAFCPDT2",4,0) ; "RTN","VAFCPDT2",5,0) CMORHIS ;Find CMOR History "RTN","VAFCPDT2",6,0) I '$O(^DPT(DFN,"MPICMOR",0)) G CMORCHG "RTN","VAFCPDT2",7,0) I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",8,0) .S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",9,0) .W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDT2",10,0) D CHISHDR "RTN","VAFCPDT2",11,0) S HIS=0 F S HIS=$O(^DPT(DFN,"MPICMOR",HIS)) Q:'HIS D Q:QFLG "RTN","VAFCPDT2",12,0) .S DIC=2,DR="993",DR(2.0993)=".01;3",DA=DFN,DA(2.0993)=HIS "RTN","VAFCPDT2",13,0) .S DIQ(0)="E",DIQ="CMORNODE" "RTN","VAFCPDT2",14,0) .D EN^DIQ1 K DIC,DR,DA,DIQ "RTN","VAFCPDT2",15,0) .S HISCMOR=$G(CMORNODE(2.0993,HIS,.01,"E")) "RTN","VAFCPDT2",16,0) .I +HISCMOR S HISCMOR=$$GET1^DIQ(4,HISCMOR,.01) "RTN","VAFCPDT2",17,0) .S CHGDT=$G(CMORNODE(2.0993,HIS,3,"E")) "RTN","VAFCPDT2",18,0) .I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",19,0) ..S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",20,0) ..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D CHISHDR "RTN","VAFCPDT2",21,0) .W !,$P(CHGDT,"@"),?12," - CMOR changed from ",HISCMOR "RTN","VAFCPDT2",22,0) ; "RTN","VAFCPDT2",23,0) CMORCHG ;Find CMOR change request "RTN","VAFCPDT2",24,0) I '$O(^MPIF(984.9,"C",DFN,0)) G EXT "RTN","VAFCPDT2",25,0) I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",26,0) .S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",27,0) .W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDT2",28,0) D CCHGHDR "RTN","VAFCPDT2",29,0) S CHG=0 F S CHG=$O(^MPIF(984.9,"C",DFN,CHG)) Q:'CHG D Q:QFLG "RTN","VAFCPDT2",30,0) .S DIC=984.9,DA=CHG,DR=".01;.03;.06;.07;.08;1.03",DIQ="CHGNODE" "RTN","VAFCPDT2",31,0) .S DIQ(0)="EI" D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDT2",32,0) .S CHGNUM=$G(CHGNODE(984.9,CHG,.01,"E")) "RTN","VAFCPDT2",33,0) .S CHGDT=$G(CHGNODE(984.9,CHG,.03,"E")) "RTN","VAFCPDT2",34,0) .S TMSG=$G(CHGNODE(984.9,CHG,.08,"E")) "RTN","VAFCPDT2",35,0) .S TREQ=$G(CHGNODE(984.9,CHG,1.03,"E")) "RTN","VAFCPDT2",36,0) .S SITE=$G(CHGNODE(984.9,CHG,.07,"E")) "RTN","VAFCPDT2",37,0) .S STATUS=$G(CHGNODE(984.9,CHG,.06,"E")) "RTN","VAFCPDT2",38,0) .I $Y+4>IOSL&($E(IOST,1,2)="C-") D Q:QFLG "RTN","VAFCPDT2",39,0) ..S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",40,0) ..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D CCHGHDR "RTN","VAFCPDT2",41,0) .W !,"REQUEST #",CHGNUM," - ",TMSG," ",CHGDT "RTN","VAFCPDT2",42,0) .W !?4,"Type of Request: ",TREQ," ",SITE "RTN","VAFCPDT2",43,0) .W !?4,"Status : ",STATUS,! "RTN","VAFCPDT2",44,0) ; "RTN","VAFCPDT2",45,0) EXT ;Extended patient demographic data "RTN","VAFCPDT2",46,0) I $E(IOST,1,2)="C-" D Q:QFLG "RTN","VAFCPDT2",47,0) .S LNQ=22 D SS^VAFCPDAT Q:QFLG "RTN","VAFCPDT2",48,0) .W @IOF "RTN","VAFCPDT2",49,0) I QFLG=1 G QUIT^VAFCPDAT "RTN","VAFCPDT2",50,0) W !!,"Additional DPT Data for: ",NAME," (DFN #",DFN,")",!,LN2 "RTN","VAFCPDT2",51,0) S DA=DFN,DIC=2,DIQ="XDATA",DIQ(0)="EI" "RTN","VAFCPDT2",52,0) S DR=".05;.08;.092;.093;.219;.2401;.2402;.2403;.211;.302;.323;.341;.331;.361;1901;.325;.328;.326;.327;.097;.525;391" ;**876 - MVI_3432 (cml) "RTN","VAFCPDT2",53,0) N COB,SOB,FNM,MNM,MMNM,NOK,NOKN,DESIG,EMER,ELIG,VET,SRVBR,SRVNUM,SRVEDT,SRVSDT,SRVCPCT,POSRVC,FILEDT,MARS,RELP,POW,NODE,MSD,PATTYPE ;**876 - MVI_3432 (cml) "RTN","VAFCPDT2",54,0) D EN^DIQ1 K DIC,DA,DR,DIQ "RTN","VAFCPDT2",55,0) S COB=$G(XDATA(2,DFN,.092,"E")),SOB=$G(XDATA(2,DFN,.093,"E")) "RTN","VAFCPDT2",56,0) S FILEDT=$G(XDATA(2,DFN,.097,"E")),FNM=$G(XDATA(2,DFN,.2401,"E")) "RTN","VAFCPDT2",57,0) S MNM=$G(XDATA(2,DFN,.2402,"E")),MMNM=$G(XDATA(2,DFN,.2403,"E")) "RTN","VAFCPDT2",58,0) S NOK=$G(XDATA(2,DFN,.211,"E")),DESIG=$G(XDATA(2,DFN,.341,"E")) "RTN","VAFCPDT2",59,0) S EMER=$G(XDATA(2,DFN,.331,"E")) "RTN","VAFCPDT2",60,0) S ELIG=$G(XDATA(2,DFN,.361,"E")),VET=$G(XDATA(2,DFN,1901,"E")) "RTN","VAFCPDT2",61,0) S SRVBR=$G(XDATA(2,DFN,.325,"E")),SRVNUM=$G(XDATA(2,DFN,.328,"E")) "RTN","VAFCPDT2",62,0) S SRVEDT=$G(XDATA(2,DFN,.326,"E")),SRVSDT=$G(XDATA(2,DFN,.327,"E")) "RTN","VAFCPDT2",63,0) S MARS=$G(XDATA(2,DFN,.05,"E")),RELP=$G(XDATA(2,DFN,.08,"E")) "RTN","VAFCPDT2",64,0) S POSRVC=$G(XDATA(2,DFN,.323,"E")),SRVCPCT=$G(XDATA(2,DFN,.302,"E")) "RTN","VAFCPDT2",65,0) S NOKN=$G(XDATA(2,DFN,.219,"E")),POW=$G(XDATA(2,DFN,.525,"E")) "RTN","VAFCPDT2",66,0) S PATTYPE=$G(XDATA(2,DFN,391,"E")) ;**876 - MVI_3432 (cml) "RTN","VAFCPDT2",67,0) ; "RTN","VAFCPDT2",68,0) W !,"PLACE OF BIRTH [CITY]",?31,": ",COB "RTN","VAFCPDT2",69,0) W !,"PLACE OF BIRTH [STATE]",?31,": ",SOB "RTN","VAFCPDT2",70,0) W !,"FATHER'S NAME",?31,": ",FNM "RTN","VAFCPDT2",71,0) W !,"MOTHER'S NAME",?31,": ",MNM "RTN","VAFCPDT2",72,0) W !,"MOTHER'S MAIDEN NAME",?31,": ",MMNM "RTN","VAFCPDT2",73,0) W !,"NAME OF PRIMARY NEXT OF KIN",?31,": ",NOK "RTN","VAFCPDT2",74,0) W !,"NEXT OF KIN PHONE NUMBER",?31,": ",NOKN "RTN","VAFCPDT2",75,0) W !,"NAME OF DESIGNEE",?31,": ",DESIG "RTN","VAFCPDT2",76,0) W !,"EMERGENCY NAME",?31,": ",EMER "RTN","VAFCPDT2",77,0) W !,"MARITAL STATUS",?31,": ",MARS "RTN","VAFCPDT2",78,0) W !,"RELIGIOUS PREFERENCE",?31,": ",RELP "RTN","VAFCPDT2",79,0) ; "RTN","VAFCPDT2",80,0) D DEM^VADPT "RTN","VAFCPDT2",81,0) ;ETHNICITY info "RTN","VAFCPDT2",82,0) I $G(VADM(11,1)) W !,"ETHNICITY INFORMATION",?31,": ",$P(VADM(11,1),"^",2) "RTN","VAFCPDT2",83,0) ; "RTN","VAFCPDT2",84,0) ;RACE multiple "RTN","VAFCPDT2",85,0) I $O(VADM(12,0)) D "RTN","VAFCPDT2",86,0) .W !,"RACE INFORMATION (multiple):" "RTN","VAFCPDT2",87,0) .S RACEMUL=0 F S RACEMUL=$O(VADM(12,RACEMUL)) Q:'RACEMUL W !?3,$P(VADM(12,RACEMUL),"^",2) "RTN","VAFCPDT2",88,0) ; "RTN","VAFCPDT2",89,0) W !,"PRIMARY ELIGIBILITY CODE",?31,": ",ELIG "RTN","VAFCPDT2",90,0) W !,"PATIENT TYPE",?31,": ",PATTYPE ;**876 - MVI_3432 (cml) "RTN","VAFCPDT2",91,0) W !,"VETERAN (Y/N)?",?31,": ",VET "RTN","VAFCPDT2",92,0) W !,"SERVICE CONNECTED PERCENT",?31,": ",SRVCPCT "RTN","VAFCPDT2",93,0) W !,"PERIOD OF SERVICE",?31,": ",POSRVC "RTN","VAFCPDT2",94,0) W !,"POW STATUS INDICATED?",?31,": ",POW "RTN","VAFCPDT2",95,0) ; "RTN","VAFCPDT2",96,0) ;Military Service Data multiple "RTN","VAFCPDT2",97,0) I $O(^DPT(DFN,.3216,0)) D "RTN","VAFCPDT2",98,0) .W !,"MILITARY SERVICE (multiple):" "RTN","VAFCPDT2",99,0) .W !,"Service Branch Service # Entry DT Separation DT" "RTN","VAFCPDT2",100,0) .W !,"---------------------------------------------------------" "RTN","VAFCPDT2",101,0) .K MSDARR "RTN","VAFCPDT2",102,0) .S MSD=0 F S MSD=$O(^DPT(DFN,.3216,MSD)) Q:'MSD D "RTN","VAFCPDT2",103,0) ..S NODE=^DPT(DFN,.3216,MSD,0) "RTN","VAFCPDT2",104,0) ..S SRVEDT=$P(NODE,"^"),SRVSDT=$P(NODE,"^",2),SRVNUM=$P(NODE,"^",5),SRVBR=$$GET1^DIQ(23,$P(NODE,"^",3),.01) "RTN","VAFCPDT2",105,0) ..S MSDARR(-SRVEDT)=SRVSDT_"^"_SRVNUM_"^"_SRVBR "RTN","VAFCPDT2",106,0) .S SRVEDT="" F S SRVEDT=$O(MSDARR(SRVEDT)) Q:'SRVEDT D "RTN","VAFCPDT2",107,0) ..W !?0,$P(MSDARR(SRVEDT),"^",3),?17,$P(MSDARR(SRVEDT),"^",2),?29,$$FMTE^XLFDT($P(SRVEDT,"-",2)),?44,$$FMTE^XLFDT(+MSDARR(SRVEDT)) "RTN","VAFCPDT2",108,0) ; "RTN","VAFCPDT2",109,0) ;ALIAS multiple "RTN","VAFCPDT2",110,0) I $O(^DPT(DFN,.01,0)) D "RTN","VAFCPDT2",111,0) .W !,"ALIAS (multiple):" "RTN","VAFCPDT2",112,0) .S ALIAS=0 F S ALIAS=$O(^DPT(DFN,.01,ALIAS)) Q:'ALIAS W !?3,$E($P(^DPT(DFN,.01,ALIAS,0),"^"),1,30),?35,"SSN: "_$P($G(^DPT(DFN,.01,ALIAS,0)),"^",2) "RTN","VAFCPDT2",113,0) ; "RTN","VAFCPDT2",114,0) ; Preferred Name "RTN","VAFCPDT2",115,0) I $G(DNODE(2,DFN,.2405,"E"))]"" W !,"PREFERRED NAME",?31,": ",DNODE(2,DFN,.2405,"E") "RTN","VAFCPDT2",116,0) ; "RTN","VAFCPDT2",117,0) W !,"DATE ENTERED IN PATIENT FILE",?31,": ",FILEDT "RTN","VAFCPDT2",118,0) ; "RTN","VAFCPDT2",119,0) K ALIAS,XDATA,CHG,CHGNUM,CHGDT,TMSG,TREQ,SITE,STATUS,HIS,HISCMOR,CMORNODE,CHGNODE,RACEMUL,VADM,MSDARR "RTN","VAFCPDT2",120,0) Q "RTN","VAFCPDT2",121,0) ; "RTN","VAFCPDT2",122,0) CHISHDR W !!,"CMOR History:",!,"--------------" "RTN","VAFCPDT2",123,0) Q "RTN","VAFCPDT2",124,0) CCHGHDR W !!,"CMOR Change Request History:",!,"----------------------------" "RTN","VAFCPDT2",125,0) Q "RTN","VAFCQRY1") 0^1^B86325384^B82687106 "RTN","VAFCQRY1",1,0) VAFCQRY1 ;BIR/DLR-Query for patient demographics ;22 Dec 2011 12:11 PM "RTN","VAFCQRY1",2,0) ;;5.3;Registration;**428,474,477,575,627,648,698,711,707,837,874,937**;Aug 13, 1993;Build 3 "RTN","VAFCQRY1",3,0) ; "RTN","VAFCQRY1",4,0) ;Reference to $$GETDFNS^MPIF002 supported by IA #3634. "RTN","VAFCQRY1",5,0) ; "RTN","VAFCQRY1",6,0) BLDPID(DFN,CNT,SEQ,PID,HL,ERR) ;build PID from File #2 "RTN","VAFCQRY1",7,0) ; Variable list "RTN","VAFCQRY1",8,0) ; DFN - internal PATIENT (#2) number "RTN","VAFCQRY1",9,0) ; CNT - value to be place in PID seq#1 (SET ID) "RTN","VAFCQRY1",10,0) ; SEQ - variable consisting of sequence numbers delimited by commas "RTN","VAFCQRY1",11,0) ; that will be used to build the message (default is ALL) "RTN","VAFCQRY1",12,0) ; PID (passed by reference) - array location to place PID segment "RTN","VAFCQRY1",13,0) ; result, the array can have existing values when passed. "RTN","VAFCQRY1",14,0) ; HL - array that contains the necessary HL variables (init^hlsub) "RTN","VAFCQRY1",15,0) ; ERR - array that is used to return an error "RTN","VAFCQRY1",16,0) ; "RTN","VAFCQRY1",17,0) N VAFCMN,VAFCMMN,SITE,VAFCZN,SSN,SITE,APID,HIST,HISTDT,VAFCHMN,NXT,NXTC,COMP,REP,SUBCOMP,STATE,CITY,CLAIM,HLECH,HLFS,HLQ,STATEIEN,SARY,LVL,LNGTH,X,STN,SITA,HLES "RTN","VAFCQRY1",18,0) I '$D(SEQ) S SEQ="ALL" "RTN","VAFCQRY1",19,0) I SEQ="" S SEQ="ALL" "RTN","VAFCQRY1",20,0) I SEQ'="ALL" D "RTN","VAFCQRY1",21,0) .; setting up temp array to hold fields to be included in message "RTN","VAFCQRY1",22,0) .N POS,EN S POS=1 F S EN=$P(SEQ,",",POS) Q:EN="" S SARY(EN)="",POS=POS+1 "RTN","VAFCQRY1",23,0) S HLECH=HL("ECH"),HLFS=HL("FS"),HLQ=HL("Q"),(COMP,HL("COMP"))=$E(HL("ECH"),1) "RTN","VAFCQRY1",24,0) S (SUBCOMP,HL("SUBCOMP"))=$E(HL("ECH"),4),(REP,HL("REP"))=$E(HL("ECH"),2),HLES=$E(HL("ECH"),3) "RTN","VAFCQRY1",25,0) ;get Patient File MPI node "RTN","VAFCQRY1",26,0) S VAFCMN="" "RTN","VAFCQRY1",27,0) N X S X="MPIFAPI" X ^%ZOSF("TEST") I $T S VAFCMN=$$MPINODE^MPIFAPI(DFN) "RTN","VAFCQRY1",28,0) I +VAFCMN<0 S VAFCMN="" "RTN","VAFCQRY1",29,0) S VAFCZN=^DPT(DFN,0),SSN=$P(^DPT(DFN,0),"^",9) "RTN","VAFCQRY1",30,0) N VAFCA,VAFCA1 D GETS^DIQ(2,DFN_",","1*","E","VAFCA") ;**698 GETTING ALIAS INFO "RTN","VAFCQRY1",31,0) ;** 707 reformat alias information to include ALIAS SSN in PID-3 with a location reference to the name in PID-5 "RTN","VAFCQRY1",32,0) I $D(VAFCA) N CT,ENT S CT=0,ENT="" F S ENT=$O(VAFCA(2.01,ENT)) Q:ENT="" D "RTN","VAFCQRY1",33,0) .S CT=CT+1 "RTN","VAFCQRY1",34,0) .S VAFCA1(CT,"NAME")=$G(VAFCA(2.01,ENT,.01,"E")) "RTN","VAFCQRY1",35,0) .;I $G(VAFCA(2.01,ENT,1,"E"))'="" S VAFCA1("SSN")="",VAFCA1(CT,"SSN")=$G(VAFCA(2.01,ENT,1,"E")) "RTN","VAFCQRY1",36,0) .S VAFCA1(CT,"SSN")=$G(VAFCA(2.01,ENT,1,"E")) "RTN","VAFCQRY1",37,0) S SITE=$$SITE^VASITE,STN=$P($$SITE^VASITE,"^",3) "RTN","VAFCQRY1",38,0) N TMP F TMP=1:1:31 S APID(TMP)="" "RTN","VAFCQRY1",39,0) S APID(2)=CNT "RTN","VAFCQRY1",40,0) ;list of fields used for backwards compatibility with HDR "RTN","VAFCQRY1",41,0) I $D(SARY(2))!(SEQ="ALL") I VAFCMN'="" S APID(3)=$P(VAFCMN,"^")_"V"_$P(VAFCMN,"^",2) ;Patient ID "RTN","VAFCQRY1",42,0) ;repeat patient ID list including ICN (NI),SSN (SS),CLAIM# (PN) and DFN (PI) "RTN","VAFCQRY1",43,0) I $D(SARY(3))!(SEQ="ALL") D "RTN","VAFCQRY1",44,0) .S APID(4)="" "RTN","VAFCQRY1",45,0) .;National Identifier (ICN) "RTN","VAFCQRY1",46,0) .I VAFCMN'="",+VAFCMN>0 D "RTN","VAFCQRY1",47,0) ..I $E($P(VAFCMN,"^"),1,3)=STN S SITA=STN "RTN","VAFCQRY1",48,0) ..I $E($P(VAFCMN,"^"),1,3)'=STN S SITA="200M" ; **707 update assigning authority for national ICNs to 200M for MPI "RTN","VAFCQRY1",49,0) ..S APID(4)=$P(VAFCMN,"^")_"V"_$P(VAFCMN,"^",2)_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP_SITA_SUBCOMP_"L" D "RTN","VAFCQRY1",50,0) ..;Assumption that if this is a local ICN at this point send the message with an expiration date of today, so that it will be treated as a deprecated ID and stored on the MPI as such "RTN","VAFCQRY1",51,0) ..I $E($P(VAFCMN,"^"),1,3)=$P($$SITE^VASITE,"^",3) S APID(4)=APID(4)_COMP_COMP_$$HLDATE^HLFNC(DT,"DT") ;**707 TO ONLY SEND DATE NO TIME "RTN","VAFCQRY1",52,0) .I $G(SSN)'="" S APID(4)=APID(4)_$S(APID(4)'="":REP,1:"")_SSN_COMP_COMP_COMP_"USSSA"_SUBCOMP_SUBCOMP_"0363"_COMP_"SS"_COMP_"VA FACILITY ID"_SUBCOMP_$$STA^XUAF4(+SITE)_SUBCOMP_"L" "RTN","VAFCQRY1",53,0) .S NXTC=0,LVL=0 ;**837,MVI_879: Move here, so that LVL gets set before pulling in TIN and FIN "RTN","VAFCQRY1",54,0) .;**837,MVI_879: Get TIN and FIN from Patient file and put in PID-3 "RTN","VAFCQRY1",55,0) .N TIN,FIN,REF "RTN","VAFCQRY1",56,0) .S TIN=$P(VAFCMN,"^",8),FIN=$P(VAFCMN,"^",9),REF=$NA(APID(4)) "RTN","VAFCQRY1",57,0) .D ADDLINE($S(TIN="":HLQ,1:TIN)_COMP_COMP_COMP_"USDOD"_SUBCOMP_SUBCOMP_"0363"_COMP_"TIN"_COMP_"VA FACILITY ID"_SUBCOMP_$$STA^XUAF4(+SITE)_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",58,0) .D ADDLINE($S(FIN="":HLQ,1:FIN)_COMP_COMP_COMP_"USDOD"_SUBCOMP_SUBCOMP_"0363"_COMP_"FIN"_COMP_"VA FACILITY ID"_SUBCOMP_$$STA^XUAF4(+SITE)_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",59,0) .I $G(DFN)'="" D "RTN","VAFCQRY1",60,0) ..D ADDLINE(DFN_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"PI"_COMP_"VA FACILITY ID"_SUBCOMP_$$STA^XUAF4(+SITE)_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",61,0) ..;CLAIM# **707 moved dfn and claim number up here since Alias SSN could be many "RTN","VAFCQRY1",62,0) ..I $D(^DPT(DFN,.31)) S CLAIM=$P(^DPT(DFN,.31),"^",3) I +CLAIM>0 D ADDLINE(CLAIM_COMP_COMP_COMP_"USVBA"_SUBCOMP_SUBCOMP_"0363"_COMP_"PN"_COMP_"VA FACILITY ID"_SUBCOMP_$$STA^XUAF4(+SITE)_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",63,0) .I $D(VAFCA1) D "RTN","VAFCQRY1",64,0) ..;Have Alias SSNs "RTN","VAFCQRY1",65,0) ..S CT=0 F S CT=$O(VAFCA1(CT)) Q:+CT<1 D "RTN","VAFCQRY1",66,0) ...S NXT=$S($G(VAFCA1(CT,"SSN"))="":HL("Q"),1:$G(VAFCA1(CT,"SSN")))_COMP_COMP_COMP_"USSSA"_SUBCOMP_SUBCOMP_"0363"_COMP_"SS"_COMP_"VA FACILITY ID"_SUBCOMP_$$STA^XUAF4(+SITE)_SUBCOMP_"L"_COMP_COMP_$$HLDATE^HLFNC(DT,"DT") "RTN","VAFCQRY1",67,0) ...I LVL=0 D "RTN","VAFCQRY1",68,0) ....I $L(APID(4)_NXT)'>244 S APID(4)=APID(4)_REP_NXT Q "RTN","VAFCQRY1",69,0) ....I $L(APID(4)_NXT)>244 S LVL=1 S LNGTH=244-$L(APID(4)),APID(4)=APID(4)_REP_$E(NXT,1,LNGTH) S LNGTH=LNGTH+1,NXT=$E(NXT,LNGTH,$L(NXT)),NXTC=1 "RTN","VAFCQRY1",70,0) ...I LVL>0 D "RTN","VAFCQRY1",71,0) ....I $L($G(APID(4,LVL))_NXT)'>245 S APID(4,LVL)=$G(APID(4,LVL))_$S(NXTC=0:REP,1:"")_NXT Q "RTN","VAFCQRY1",72,0) ....I $L($G(APID(4,LVL))_NXT)>245 S LNGTH=244-$L(APID(4,LVL)),APID(4,LVL)=APID(4,LVL)_REP_$E(NXT,1,LNGTH) S LNGTH=LNGTH+1,NXT=$E(NXT,LNGTH,$L(NXT)) S LVL=LVL+1 S APID(4,LVL)=NXT "RTN","VAFCQRY1",73,0) ...I NXTC=1 S NXTC=0 "RTN","VAFCQRY1",74,0) .I $D(^DPT(DFN,"MPIFHIS")) N HIST S HIST=0 F S HIST=$O(^DPT(DFN,"MPIFHIS",HIST)) Q:'HIST S VAFCHMN=^DPT(DFN,"MPIFHIS",HIST,0) S HISTDT=$P(VAFCHMN,"^",4) D "RTN","VAFCQRY1",75,0) ..;**477 due to a timing issue if checksum and D/T of deprication of ICN is not present hang two seconds and try again if still not able to get ICN set D/T to DT "RTN","VAFCQRY1",76,0) ..I $G(HISTDT)="" H 2 S VAFCHMN=^DPT(DFN,"MPIFHIS",HIST,0) S HISTDT=$P(VAFCHMN,"^",4) I HISTDT="" S HISTDT=DT "RTN","VAFCQRY1",77,0) ..I APID(4)'="" D "RTN","VAFCQRY1",78,0) ...I $E($P(VAFCHMN,"^"),1,3)=STN S SITA=STN "RTN","VAFCQRY1",79,0) ...I $E($P(VAFCHMN,"^"),1,3)'=STN S SITA="200M" ; **707 update assigning authority for national ICNs to 200M for MPI "RTN","VAFCQRY1",80,0) ...S NXT=$P(VAFCHMN,"^")_"V"_$P(VAFCHMN,"^",2)_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP_SITA_SUBCOMP_"L"_COMP_COMP_$$HLDATE^HLFNC(HISTDT,"DT") ;**648 only send date not time "RTN","VAFCQRY1",81,0) ...I LVL=0 D "RTN","VAFCQRY1",82,0) ....I $L(APID(4)_NXT)'>244 S APID(4)=APID(4)_REP_NXT Q "RTN","VAFCQRY1",83,0) ....I $L(APID(4)_NXT)>244 S LVL=1 S LNGTH=244-$L(APID(4)),APID(4)=APID(4)_REP_$E(NXT,1,LNGTH) S LNGTH=LNGTH+1,NXT=$E(NXT,LNGTH,$L(NXT)),NXTC=1 "RTN","VAFCQRY1",84,0) ...I LVL>0 D "RTN","VAFCQRY1",85,0) ....I $L($G(APID(4,LVL))_NXT)'>245 S APID(4,LVL)=$G(APID(4,LVL))_$S(NXTC=0:REP,1:"")_NXT Q "RTN","VAFCQRY1",86,0) ....I $L($G(APID(4,LVL))_NXT)>245 S LNGTH=244-$L(APID(4,LVL)),APID(4,LVL)=APID(4,LVL)_REP_$E(NXT,1,LNGTH) S LNGTH=LNGTH+1,NXT=$E(NXT,LNGTH,$L(NXT)) S LVL=LVL+1 S APID(4,LVL)=NXT "RTN","VAFCQRY1",87,0) ..I NXTC=1 S NXTC=0 "RTN","VAFCQRY1",88,0) ..I APID(4)="" D "RTN","VAFCQRY1",89,0) ...I $E($P(VAFCHMN,"^"),1,3)=STN S SITA=STN "RTN","VAFCQRY1",90,0) ...I $E($P(VAFCHMN,"^"),1,3)'=STN S SITA="200M" "RTN","VAFCQRY1",91,0) ...S APID(4)=$P(VAFCHMN,"^")_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP_SITA_SUBCOMP_"L"_COMP_COMP_$$HLDATE^HLFNC(HISTDT,"DT") ;**707 ONLY DATE NOT TIME "RTN","VAFCQRY1",92,0) ; "RTN","VAFCQRY1",93,0) ALTID ;**874 MVI_3035 (elz) alternate ID "RTN","VAFCQRY1",94,0) I $D(SARY(4))!(SEQ="ALL") D "RTN","VAFCQRY1",95,0) . S REF=$NA(APID(5)),@REF="",LVL=0 "RTN","VAFCQRY1",96,0) . I $G(DFN) D "RTN","VAFCQRY1",97,0) .. ;VIC card number, station 742V1 "RTN","VAFCQRY1",98,0) .. N VAVICF,VAVICX,VAVIC,X "RTN","VAFCQRY1",99,0) .. S VAVICF=+$$LKUP^XUAF4("742V1") "RTN","VAFCQRY1",100,0) .. S VAVICX=0 F S VAVICX=$O(^DGCN(391.91,"APAT",DFN,VAVICF,VAVICX)) Q:'VAVICX D "RTN","VAFCQRY1",101,0) ... F X=0,2 S VAVIC(X)=$G(^DGCN(391.91,VAVICX,X)) "RTN","VAFCQRY1",102,0) ... I $P(VAVIC(2),"^",2),$P(VAVIC(2),"^",3)'="H",$L($P(VAVIC(2),"^")),$L($P(VAVIC(0),"^",9)) D "RTN","VAFCQRY1",103,0) .... D ADDLINE($P(VAVIC(2),"^",2)_COMP_COMP_COMP_$P(VAVIC(2),"^")_SUBCOMP_SUBCOMP_"0363"_COMP_$P(VAVIC(0),"^",9)_COMP_"VA FACILITY ID"_SUBCOMP_"742V1"_SUBCOMP_"L",.LVL,REF,REP) "RTN","VAFCQRY1",104,0) ; "RTN","VAFCQRY1",105,0) NAMEPID ;patient name (last^first^middle^suffix^prefix^^"L" for legal) "RTN","VAFCQRY1",106,0) I $D(SARY(5))!(SEQ="ALL") D "RTN","VAFCQRY1",107,0) .;**711 code REMOVED PREFIX due to issues with existing PATIENT Name Standardization functionality "RTN","VAFCQRY1",108,0) .N X S X=$P(VAFCZN,"^") D NAME^VAFCPID2(DFN,.X) S APID(6)=$$HLNAME^XLFNAME(X,"",$E(HL("ECH"),1)) I $P(APID(6),$E(HL("ECH"),1),7)'="L" S $P(APID(6),$E(HL("ECH"),1),7)="L" "RTN","VAFCQRY1",109,0) PREFNAME .; Story 455447 (elz)DG*5.3*937 Preferred Name (^preferred name^^^^^"N" for nickname) "RTN","VAFCQRY1",110,0) .N PREFNAM S PREFNAM=$P($G(^DPT(DFN,.24)),"^",5) "RTN","VAFCQRY1",111,0) .D HL7TXT(.PREFNAM,.HL,HLES) S APID(6)=APID(6)_$S(APID(6)]"":REP,1:"")_$S(PREFNAM]"":PREFNAM,1:"""""")_COMP_COMP_COMP_COMP_COMP_COMP_"N" "RTN","VAFCQRY1",112,0) ALIAS .;patient alias (last^first^middle^suffice^prefix^^"A" for alias - can be multiple) "RTN","VAFCQRY1",113,0) .N ALIAS,ALIEN,LVL6,NXTC,LNGTH S NXTC=0,LVL6=0 "RTN","VAFCQRY1",114,0) .I $D(VAFCA1) S ALIEN=0 F S ALIEN=$O(VAFCA1(ALIEN)) Q:'ALIEN D "RTN","VAFCQRY1",115,0) ..S ALIAS=$$HLNAME^XLFNAME(VAFCA1(ALIEN,"NAME"),"",$E(HL("ECH"),1)) "RTN","VAFCQRY1",116,0) ..Q:ALIAS="" "RTN","VAFCQRY1",117,0) ..S $P(ALIAS,$E(HL("ECH"),1),7)="A" "RTN","VAFCQRY1",118,0) ..I LVL6=0 D "RTN","VAFCQRY1",119,0) ...I $L(APID(6)_ALIAS)'>244 S APID(6)=APID(6)_REP_ALIAS Q "RTN","VAFCQRY1",120,0) ...I $L(APID(6)_ALIAS)>244 S LVL6=1 S LNGTH=244-$L(APID(6)),APID(6)=APID(6)_REP_$E(ALIAS,1,LNGTH) S LNGTH=LNGTH+1,ALIAS=$E(ALIAS,LNGTH,$L(ALIAS)),NXTC=1 "RTN","VAFCQRY1",121,0) ..I LVL6>0 D "RTN","VAFCQRY1",122,0) ...I $L($G(APID(6,LVL6))_ALIAS)'>245 S APID(6,LVL6)=$G(APID(6,LVL6))_$S(NXTC=0:REP,1:"")_ALIAS Q "RTN","VAFCQRY1",123,0) ...I $L($G(APID(6,LVL6))_ALIAS)>245 S LNGTH=244-$L(APID(6,LVL6)),APID(6,LVL6)=APID(6,LVL6)_REP_$E(ALIAS,1,LNGTH) S LNGTH=LNGTH+1,ALIAS=$E(ALIAS,LNGTH,$L(ALIAS)) S LVL6=LVL6+1 S APID(6,LVL6)=ALIAS "RTN","VAFCQRY1",124,0) ..I NXTC=1 S NXTC=0 "RTN","VAFCQRY1",125,0) . I APID(6)="" S APID(6)=HL("Q") "RTN","VAFCQRY1",126,0) MOTHER ;mother's maiden name (last^first^middle^suffix^prefix^^"M" for maiden name) "RTN","VAFCQRY1",127,0) I $D(SARY(6))!(SEQ="ALL") D "RTN","VAFCQRY1",128,0) .S APID(7)=HL("Q") "RTN","VAFCQRY1",129,0) .I $D(^DPT(DFN,.24)) S VAFCMMN=$P(^DPT(DFN,.24),"^",3) D "RTN","VAFCQRY1",130,0) ..S APID(7)=$$HLNAME^XLFNAME(VAFCMMN,"",$E(HL("ECH"),1)) I APID(7)="" S APID(7)=HL("Q") "RTN","VAFCQRY1",131,0) ..I $P(APID(7),$E(HL("ECH"),1),7)'="M" S $P(APID(7),$E(HL("ECH"),1),7)="M" "RTN","VAFCQRY1",132,0) .I APID(7)="" S APID(7)=HL("Q") "RTN","VAFCQRY1",133,0) I $D(SARY(7))!(SEQ="ALL") S APID(8)=$$HLDATE^HLFNC($P(VAFCZN,"^",3)) I APID(8)="" S APID(8)=HL("Q") ;date/time of birth "RTN","VAFCQRY1",134,0) I $D(SARY(8))!(SEQ="ALL") S APID(9)=$P(VAFCZN,"^",2) I APID(9)="" S APID(9)=HL("Q") ;sex "RTN","VAFCQRY1",135,0) ;place of birth city and state "RTN","VAFCQRY1",136,0) ;split into 2 routines **707 "RTN","VAFCQRY1",137,0) D CONT^VAFCQRY3(DFN,.APID,.PID,.HL,HLES,.SARY,SEQ,.ERR,REP,COMP,SSN,VAFCMN) "RTN","VAFCQRY1",138,0) D KVA^VADPT "RTN","VAFCQRY1",139,0) Q "RTN","VAFCQRY1",140,0) HL7TXT(HL7STRG,HL,HLES) ; Replace occurrences of embedded HL7 delimiters with "RTN","VAFCQRY1",141,0) ; HL7 escape sequence "RTN","VAFCQRY1",142,0) ; "RTN","VAFCQRY1",143,0) ; Inputs: HL7STRG - Data string to be checked "RTN","VAFCQRY1",144,0) ; HL("ECH") - HL7 delimiter string "RTN","VAFCQRY1",145,0) ; Delimiters MUST be in the following order, "RTN","VAFCQRY1",146,0) ; Escape, Field, Component, Repeat, Subcomponent "RTN","VAFCQRY1",147,0) ; Example: \^~|& "RTN","VAFCQRY1",148,0) ; "RTN","VAFCQRY1",149,0) ; Output: HL7XTRG - Data string with escape sequence added (if needed) "RTN","VAFCQRY1",150,0) ; "RTN","VAFCQRY1",151,0) N OCHR,RCHR,RCHRI,TYPE,I,HLES2 "RTN","VAFCQRY1",152,0) ; "RTN","VAFCQRY1",153,0) I $G(HL("COMP"))="" S HL("COMP")=$E(HL("ECH"),1),HL("REP")=$E(HL("ECH"),2),HL("SUBCOMP")=$E(HL("ECH"),4) "RTN","VAFCQRY1",154,0) ; Set HL7 escape char "RTN","VAFCQRY1",155,0) S HLES2=HLES_HL("FS")_HL("COMP")_HL("REP")_HL("SUBCOMP") "RTN","VAFCQRY1",156,0) ; "RTN","VAFCQRY1",157,0) ; Search for occurrence of each delimiter and replace it with "\\" "RTN","VAFCQRY1",158,0) F TYPE="E","F","C","R","S" D "RTN","VAFCQRY1",159,0) . S RCHRI=$S(TYPE="E":1,TYPE="F":2,TYPE="C":3,TYPE="R":4,TYPE="S":5) "RTN","VAFCQRY1",160,0) . ; "RTN","VAFCQRY1",161,0) . ; OCHR=original char, RCHR=replacement char "RTN","VAFCQRY1",162,0) . S OCHR=$E(HLES2,RCHRI),RCHR=$E("EFSRT",RCHRI) Q:'$F(HL7STRG,OCHR) "RTN","VAFCQRY1",163,0) . F I=1:1 Q:$E(HL7STRG,I)="" I $E(HL7STRG,I)=OCHR S HL7STRG=$E(HL7STRG,1,I-1)_HLES_RCHR_HLES_$E(HL7STRG,I+1,999),I=I+2 "RTN","VAFCQRY1",164,0) Q "RTN","VAFCQRY1",165,0) ; "RTN","VAFCQRY1",166,0) ADDLINE(NXT,LVL,REF,REP) ; Prepend REP to NXT and add it to the @REF "RTN","VAFCQRY1",167,0) ; array, starting at subscript LVL. If appending NXT causes the node "RTN","VAFCQRY1",168,0) ; to exceed 245 chars in length, add as much of NXT as possible to the "RTN","VAFCQRY1",169,0) ; current level, and the remaining at the next level. "RTN","VAFCQRY1",170,0) ; In: "RTN","VAFCQRY1",171,0) ; NXT = string to add to the @REF array "RTN","VAFCQRY1",172,0) ; .LVL = current subscript level (passed by referenced) "RTN","VAFCQRY1",173,0) ; REF = array reference string "RTN","VAFCQRY1",174,0) ; REP = repetition character (e.g., |) "RTN","VAFCQRY1",175,0) ; **837,MVI_879: Created this subroutine to aid in adding TIN and FIN to PID-3. "RTN","VAFCQRY1",176,0) N LNGTH,CURREF "RTN","VAFCQRY1",177,0) S:$G(LVL)<1 LVL=0 "RTN","VAFCQRY1",178,0) S CURREF=$S(LVL=0:REF,1:$NA(@REF@(LVL))) "RTN","VAFCQRY1",179,0) I LVL>0!($G(@CURREF)]"") S NXT=REP_NXT "RTN","VAFCQRY1",180,0) I $L($G(@CURREF))+$L(NXT)'>245 S @CURREF=$G(@CURREF)_NXT "RTN","VAFCQRY1",181,0) E S LNGTH=245-$L(@CURREF),@CURREF=@CURREF_$E(NXT,1,LNGTH),LVL=LVL+1,@REF@(LVL)=$E(NXT,LNGTH+1,$L(NXT)) "RTN","VAFCQRY1",182,0) Q "RTN","VAFCTR") 0^2^B5086343^B4717959 "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**;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) ; "RTN","VAFCTR",27,0) N MVIRSLT "RTN","VAFCTR",28,0) I $G(DGFILE)'=2&($G(DGFILE)'=2.01)&($G(DGFILE)'=2.02)&($G(DGFILE)'=2.06) Q "RTN","VAFCTR",29,0) S DGFIELD=$G(DGFIELD) "RTN","VAFCTR",30,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",31,0) ;**902 MVI_4735 (jfw) Add 4 new fields to list (Break apart long If line above) "RTN","VAFCTR",32,0) S MVIRSLT=(DGFIELD'=.01)&(DGFIELD'=994)&(DGFIELD'=.525)&(DGFIELD'=.0906)&(DGFIELD'=.121)&(DGFIELD'=.133) "RTN","VAFCTR",33,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.134)&(DGFIELD'=391)&(DGFIELD'=1901)&(DGFIELD'=.323)&(DGFIELD'=.024) "RTN","VAFCTR",34,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.352)&(DGFIELD'=.353)&(DGFIELD'=.354)&(DGFIELD'=.355)&(DGFIELD'=.357) "RTN","VAFCTR",35,0) S MVIRSLT=MVIRSLT&(DGFIELD'=.2405) "RTN","VAFCTR",36,0) Q:(MVIRSLT) "RTN","VAFCTR",37,0) I $T(AVAFC^VAFCDD01)="" Q "RTN","VAFCTR",38,0) ;The fields below are not multiples "RTN","VAFCTR",39,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",40,0) ;**902 MVI_4735 (jfw) Add 4 new fields to list (Break apart long If line above) "RTN","VAFCTR",41,0) S MVIRSLT=(DGFIELD=994)!(DGFIELD=.525)!(DGFIELD=.0906)!(DGFIELD=.121)!(DGFIELD=.133) "RTN","VAFCTR",42,0) S MVIRSLT=MVIRSLT!(DGFIELD=.134)!(DGFIELD=.024)!(DGFIELD=391)!(DGFIELD=1901)!(DGFIELD=.323) "RTN","VAFCTR",43,0) S MVIRSLT=MVIRSLT!(DGFIELD=.352)!(DGFIELD=.353)!(DGFIELD=.354)!(DGFIELD=.355)!(DGFIELD=.357) "RTN","VAFCTR",44,0) S MVIRSLT=MVIRSLT!(DGFIELD=.2405) "RTN","VAFCTR",45,0) I MVIRSLT S VAFCF=DGFIELD_";" D AVAFC^VAFCDD01(DGDA) "RTN","VAFCTR",46,0) ;The fields below ARE multiples "RTN","VAFCTR",47,0) I DGFILE=2.01 S VAFCF="1;" D AVAFC^VAFCDD01(DGDA(1)) ;ALIAS "RTN","VAFCTR",48,0) I DGFILE=2.02 S VAFCF="2.02,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;RACE INFORMATION "RTN","VAFCTR",49,0) I DGFILE=2.06 S VAFCF="2.06,.01;" D AVAFC^VAFCDD01(DGDA(1)) ;ETHNICITY INFORMATION "RTN","VAFCTR",50,0) Q "VER") 8.0^22.2 "^DD",2,2,.2405,0) PREFERRED NAME^FaX^^.24;5^K:$L(X)>100!($L(X)<1)!($TR(X," ","")?.E1NP.E) X I $D(X) S X=$$UP^XLFSTR(X) "^DD",2,2,.2405,3) Enter the Preferred Name (1-100 alphabetic characters and/or spaces) for how the patient would like to be addressed at the facility. Vulgarities and offensive language are NOT appropriate responses. "^DD",2,2,.2405,21,0) ^^8^8^3170207^ "^DD",2,2,.2405,21,1,0) The PREFERRED NAME field identifies the name that the patient would "^DD",2,2,.2405,21,2,0) prefer to be referenced by during interactions at the medical facility. "^DD",2,2,.2405,21,3,0) Only alphabetic characters and/or spaces are allowed to be entered. The "^DD",2,2,.2405,21,4,0) PREFERRED NAME value will be converted/stored as uppercase. "^DD",2,2,.2405,21,5,0) Note: Vulgarities and other offensive language such as curse and/or "^DD",2,2,.2405,21,6,0) sexual words are NOT appropriate responses. "^DD",2,2,.2405,21,7,0) Note: Examples of Preferred Name for a patient could include their rank "^DD",2,2,.2405,21,8,0) (Ie. Private LastName), a nickname, etc... "^DD",2,2,.2405,"AUDIT") y "^DD",2,2,.2405,"DT") 3170206 "BLD",3220,6) ^822 **END** **END**