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 Dec 13, 2024@02:29:49 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
