- PXP236 ;ISP/RFR - CREATE NEW-STYLE XREF ;Sep 08, 2023@15:42
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**236**;Aug 12, 1996;Build 17
- ;
- N PXXR,PXRES,PXOUT,PXMSG,PXERROR,PXMESSAGE,PXLINE
- S PXMSG(1)=" Creating the AB index definition in the V IMM CONTRA/REFUSAL EVENTS file"
- S PXMSG(2)=" (#9000010.707)..."
- D BMES^XPDUTL(.PXMSG)
- S PXXR("FILE")=9000010.707
- S PXXR("NAME")="AB"
- S PXXR("TYPE")="R"
- S PXXR("USE")="S"
- S PXXR("EXECUTION")="R"
- S PXXR("ACTIVITY")="IR"
- S PXXR("SHORT DESCR")="Sort entries by patient, then by immunization, then by visit date."
- S PXXR("DESCR",1)="This cross-reference sorts contraindication/refusal events in sequence by"
- S PXXR("DESCR",2)="patient, immunization, and then visit date."
- S PXXR("VAL",1)=.02
- S PXXR("VAL",1,"SUBSCRIPT")=1
- S PXXR("VAL",1,"COLLATION")="F"
- S PXXR("VAL",2)=.04
- S PXXR("VAL",2,"SUBSCRIPT")=2
- S PXXR("VAL",2,"COLLATION")="F"
- S PXXR("VAL",3)=.03
- S PXXR("VAL",3,"SUBSCRIPT")=3
- S PXXR("VAL",3,"COLLATION")="F"
- S PXXR("VAL",3,"XFORM FOR STORAGE")="S X=$P(+^AUPNVSIT(X,0),""."",1)"
- D CREIXN^DDMOD(.PXXR,"W",.PXRES,"PXOUT","PXERROR")
- I $G(PXRES)="" D Q
- .D BMES^XPDUTL(" FAILED to create the AB index.")
- .D MSG^DIALOG("WE",.PXMESSAGE,($G(IOM,80)-7),,"PXERROR")
- .F PXLINE=1:1:PXMESSAGE D
- ..D MES^XPDUTL(" "_PXMESSAGE(PXLINE))
- K PXMSG
- S PXMSG(1)=" DONE",PXMSG(2)=" "
- S PXMSG(3)=" Queueing a task to populate the AB index..."
- D MES^XPDUTL(.PXMSG)
- N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK,ZTSAVE
- S ZTRTN="INDEX^PXP236",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,5),ZTIO=""
- S ZTDESC="PCE V IMM CONTRA/REFUSAL EVENTS FILE AB CROSS-REFERENCE BUILDER"
- S ZTSAVE("PXPERSON")=DUZ
- D ^%ZTLOAD
- I $G(ZTSK)>0,$G(ZTSK("D"))>0 D Q
- .D MES^XPDUTL(" Task #"_ZTSK_" scheduled to run at "_$$HTE^XLFDT(ZTSK("D")))
- K PXMSG
- S PXMSG(1)=" FAILED to task the cross-reference builder"
- S PXMSG(2)=" Execute DO INDEX^PXP236 from the programmer's prompt."
- D BMES^XPDUTL(.PXMSG)
- Q
- INDEX ;BUILD AB INDEX
- N DIK,DA,PXMSG
- S DIK="^AUPNVICR(",DIK(1)=".02"_U_"AB"
- I $D(^AUPNVICR("AB")) D ENALL2^DIK
- D ENALL^DIK
- S PXMSG(2,0)="(#9000010.707)"
- I $P($G(^AUPNVICR(0)),U,4)>0 D
- .I $D(^AUPNVICR("AB")) S PXMSG(1,0)="Successfully built"
- .E S PXMSG(1,0)="Failed to build"
- .S PXMSG(1,0)=PXMSG(1,0)_" the AB index in the V IMM CONTRA/REFUSAL EVENTS file"
- .S PXMSG(2,0)=PXMSG(2,0)_"."
- I $P($G(^AUPNVICR(0)),U,4)<1 D
- .S PXMSG(1,0)="There are no entries in the V IMM CONTRA/REFUSAL EVENTS file"
- .S PXMSG(2,0)=PXMSG(2,0)_" to add to the new AB index."
- N XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMERR
- S XMDUZ="PCE PATCH 236",XMSUB="AB CROSS-REFERENCE TASK",XMTEXT="PXMSG(",XMY("I:"_PXPERSON)=""
- D ^XMD
- I $G(XMMG)'="" D
- .N %ZT S %ZT("^TMP(""XMERR"",$J)")=""
- .D APPERROR^%ZTER("PCE ERROR SENDING STATUS MESSAGE")
- S ZTREQ="@"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXP236 2905 printed Mar 13, 2025@21:34:32 Page 2
- PXP236 ;ISP/RFR - CREATE NEW-STYLE XREF ;Sep 08, 2023@15:42
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**236**;Aug 12, 1996;Build 17
- +2 ;
- +3 NEW PXXR,PXRES,PXOUT,PXMSG,PXERROR,PXMESSAGE,PXLINE
- +4 SET PXMSG(1)=" Creating the AB index definition in the V IMM CONTRA/REFUSAL EVENTS file"
- +5 SET PXMSG(2)=" (#9000010.707)..."
- +6 DO BMES^XPDUTL(.PXMSG)
- +7 SET PXXR("FILE")=9000010.707
- +8 SET PXXR("NAME")="AB"
- +9 SET PXXR("TYPE")="R"
- +10 SET PXXR("USE")="S"
- +11 SET PXXR("EXECUTION")="R"
- +12 SET PXXR("ACTIVITY")="IR"
- +13 SET PXXR("SHORT DESCR")="Sort entries by patient, then by immunization, then by visit date."
- +14 SET PXXR("DESCR",1)="This cross-reference sorts contraindication/refusal events in sequence by"
- +15 SET PXXR("DESCR",2)="patient, immunization, and then visit date."
- +16 SET PXXR("VAL",1)=.02
- +17 SET PXXR("VAL",1,"SUBSCRIPT")=1
- +18 SET PXXR("VAL",1,"COLLATION")="F"
- +19 SET PXXR("VAL",2)=.04
- +20 SET PXXR("VAL",2,"SUBSCRIPT")=2
- +21 SET PXXR("VAL",2,"COLLATION")="F"
- +22 SET PXXR("VAL",3)=.03
- +23 SET PXXR("VAL",3,"SUBSCRIPT")=3
- +24 SET PXXR("VAL",3,"COLLATION")="F"
- +25 SET PXXR("VAL",3,"XFORM FOR STORAGE")="S X=$P(+^AUPNVSIT(X,0),""."",1)"
- +26 DO CREIXN^DDMOD(.PXXR,"W",.PXRES,"PXOUT","PXERROR")
- +27 IF $GET(PXRES)=""
- Begin DoDot:1
- +28 DO BMES^XPDUTL(" FAILED to create the AB index.")
- +29 DO MSG^DIALOG("WE",.PXMESSAGE,($GET(IOM,80)-7),,"PXERROR")
- +30 FOR PXLINE=1:1:PXMESSAGE
- Begin DoDot:2
- +31 DO MES^XPDUTL(" "_PXMESSAGE(PXLINE))
- End DoDot:2
- End DoDot:1
- QUIT
- +32 KILL PXMSG
- +33 SET PXMSG(1)=" DONE"
- SET PXMSG(2)=" "
- +34 SET PXMSG(3)=" Queueing a task to populate the AB index..."
- +35 DO MES^XPDUTL(.PXMSG)
- +36 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK,ZTSAVE
- +37 SET ZTRTN="INDEX^PXP236"
- SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,5)
- SET ZTIO=""
- +38 SET ZTDESC="PCE V IMM CONTRA/REFUSAL EVENTS FILE AB CROSS-REFERENCE BUILDER"
- +39 SET ZTSAVE("PXPERSON")=DUZ
- +40 DO ^%ZTLOAD
- +41 IF $GET(ZTSK)>0
- IF $GET(ZTSK("D"))>0
- Begin DoDot:1
- +42 DO MES^XPDUTL(" Task #"_ZTSK_" scheduled to run at "_$$HTE^XLFDT(ZTSK("D")))
- End DoDot:1
- QUIT
- +43 KILL PXMSG
- +44 SET PXMSG(1)=" FAILED to task the cross-reference builder"
- +45 SET PXMSG(2)=" Execute DO INDEX^PXP236 from the programmer's prompt."
- +46 DO BMES^XPDUTL(.PXMSG)
- +47 QUIT
- INDEX ;BUILD AB INDEX
- +1 NEW DIK,DA,PXMSG
- +2 SET DIK="^AUPNVICR("
- SET DIK(1)=".02"_U_"AB"
- +3 IF $DATA(^AUPNVICR("AB"))
- DO ENALL2^DIK
- +4 DO ENALL^DIK
- +5 SET PXMSG(2,0)="(#9000010.707)"
- +6 IF $PIECE($GET(^AUPNVICR(0)),U,4)>0
- Begin DoDot:1
- +7 IF $DATA(^AUPNVICR("AB"))
- SET PXMSG(1,0)="Successfully built"
- +8 IF '$TEST
- SET PXMSG(1,0)="Failed to build"
- +9 SET PXMSG(1,0)=PXMSG(1,0)_" the AB index in the V IMM CONTRA/REFUSAL EVENTS file"
- +10 SET PXMSG(2,0)=PXMSG(2,0)_"."
- End DoDot:1
- +11 IF $PIECE($GET(^AUPNVICR(0)),U,4)<1
- Begin DoDot:1
- +12 SET PXMSG(1,0)="There are no entries in the V IMM CONTRA/REFUSAL EVENTS file"
- +13 SET PXMSG(2,0)=PXMSG(2,0)_" to add to the new AB index."
- End DoDot:1
- +14 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,XMERR
- +15 SET XMDUZ="PCE PATCH 236"
- SET XMSUB="AB CROSS-REFERENCE TASK"
- SET XMTEXT="PXMSG("
- SET XMY("I:"_PXPERSON)=""
- +16 DO ^XMD
- +17 IF $GET(XMMG)'=""
- Begin DoDot:1
- +18 NEW %ZT
- SET %ZT("^TMP(""XMERR"",$J)")=""
- +19 DO APPERROR^%ZTER("PCE ERROR SENDING STATUS MESSAGE")
- End DoDot:1
- +20 SET ZTREQ="@"
- +21 QUIT
