PXRMP72I ;SLC/AGP - Inits for PXRM*2.0*72. ;04/15/2020
;;2.0;CLINICAL REMINDERS;**72**;Feb 04, 2005;Build 16
Q
;
EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
;MODE values: I for include in build, A for include action.
N LN
S LN=0
;
S LN=LN+1
S ARRAY(LN,1)="VA-COVID-19 CPRS STATUS"
I MODE["I" S ARRAY(LN,2)="04/15/2020@11:51:56"
I MODE["A" S ARRAY(LN,3)="O"
Q
;
FINDOI(RESULT) ;
N CNODE,IDX,IEN,NAME,NODE,PIEN,PNODE
S NAME="COVID"
F S NAME=$O(^ORD(101.43,"S.LAB",NAME)) Q:NAME=""!(NAME'["COVID") D
.I $P(NAME," ")'="COVID-19" Q
.S IEN=+$O(^ORD(101.43,"S.LAB",NAME,"")) Q:IEN=0
.S NODE=$G(^ORD(101.43,IEN,0))
.I $P(NODE,U,2)'[";99LRT" Q
.;process child orderable items for panel
.I $D(^ORD(101.43,IEN,10)) D Q
..S IDX=0 F S IDX=$O(^ORD(101.43,IEN,10,IDX)) Q:IDX'>0 D
...S CNODE=$G(^ORD(101.43,IEN,10,IDX,0))
...S PIEN=$O(^ORD(101.43,"B",$P(CNODE,U),"")) Q:PIEN'>0
...S PNODE=$G(^ORD(101.43,PIEN,0))
...I $P(PNODE,U,2)'[";99LRT" Q
...S RESULT(PIEN,"NAME")=$P(PNODE,U)
...S RESULT(PIEN,"LAB")=$P(PNODE,U,1,2)
..S RESULT(IEN,"NAME")=$P(NODE,U)
.S RESULT(IEN,"NAME")=$P(NODE,U)
.S RESULT(IEN,"LAB")=$P(NODE,U,1,2)
Q
Q
;
;==========================================
PRE ;Pre-init
;Disable options and protocols
;D OPTION^PXRMUTIL("DISABLE")
;D PROTOCOL^PXRMUTIL("DISABLE")
D DELEXE^PXRMEXSI("EXARRAY","PXRMP72I")
Q
;
;==========================================
POST ;Post-init
;Install Exchange File entries.
D SMEXINS^PXRMEXSI("EXARRAY","PXRMP72I")
D SETTERMS
;D OPTION^PXRMUTIL("ENABLE")
;D PROTOCOL^PXRMUTIL("ENABLE")
D SENDIM^PXRMMSG("PXRM*2.0*72")
Q
;
;
SETTERMS ;
N ARRAY,CNT,IEN,LAB,NODE,RIEN,ORDER,RESULT,TIEN,TERMS,TEXT
N PXRMINST
S PXRMINST=1
D FINDOI(.ARRAY)
S CNT=0,IEN=0
F S IEN=$O(ARRAY(IEN)) Q:IEN'>0 D
.S CNT=CNT+1
.;set orders and order statuses
.S ORDER(CNT,.01)="OI."_ARRAY(IEN,"NAME")
.;set lab findings
.I $P($G(ARRAY(IEN,"LAB")),U)'="" S LAB(CNT,.01)="LT."_$P(ARRAY(IEN,"LAB"),U)
;update findings per term
I $D(ORDER) D
.I '$$OKTOUPD("VA-COVID-19 PCR LAB ORDERS") Q
.D SETTFIND^PXRMTUTL(.RESULT,"VA-COVID-19 PCR LAB ORDERS",.ORDER)
.I +RESULT=-1 D WRITERR("VA-COVID-19 PCR LAB ORDERS",RESULT) Q
I $D(LAB) D
.I '$$OKTOUPD("VA-COVID-19 PCR LAB RESULTS NEGATIVE") Q
.D SETTFIND^PXRMTUTL(.RESULT,"VA-COVID-19 PCR LAB RESULTS NEGATIVE",.LAB)
.I +RESULT=-1 D WRITERR("VA-COVID-19 PCR LAB RESULTS NEGATIVE",RESULT)
.;
.I '$$OKTOUPD("VA-COVID-19 PCR LAB RESULTS POSITIVE") Q
.D SETTFIND^PXRMTUTL(.RESULT,"VA-COVID-19 PCR LAB RESULTS POSITIVE",.LAB)
.I +RESULT=-1 D WRITERR("VA-COVID-19 PCR LAB RESULTS POSITIVE",RESULT)
;
;Report terms that need to be reviewed.
S TEXT(1)="Forward the list of reminder terms to the CACs"
S TEXT(2)="to review the following reminder terms setup for any"
S TEXT(3)="missing lab tests or orders"
S TEXT(4)=" VA-COVID-19 PCR LAB RESULTS NEGATIVE"
S TEXT(5)=" VA-COVID-19 PCR LAB RESULTS POSITIVE"
S TEXT(6)=" VA-COVID-19 PCR LAB ORDERS"
D MES^XPDUTL(.TEXT)
Q
;
OKTOUPD(TNAME) ;
N RESULT,TIEN,TEXT
S RESULT=1
S TIEN=$O(^PXRMD(811.5,"B",TNAME,""))
I 'TIEN D Q
.S TEXT(1)="ERROR: could not found reminder term:"
.S TEXT(2)=" "_TNAME
.D MES^XPDUTL(.TEXT)
.S RESULT=0
I RESULT,$D(^PXRMD(811.5,TIEN,20,"B")) S RESULT=0
Q RESULT
;
WRITERR(TNAME,RESULT) ;
N TEXT
S TEXT(1)="ERROR: mapping findings"
S TEXT(2)="Reminder Term: "_TNAME
S TEXT(3)=" "_$P(RESULT,U,2)
D MES^XPDUTL(.TEXT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP72I 3568 printed Sep 23, 2025@19:24:13 Page 2
PXRMP72I ;SLC/AGP - Inits for PXRM*2.0*72. ;04/15/2020
+1 ;;2.0;CLINICAL REMINDERS;**72**;Feb 04, 2005;Build 16
+2 QUIT
+3 ;
EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
+1 ;MODE values: I for include in build, A for include action.
+2 NEW LN
+3 SET LN=0
+4 ;
+5 SET LN=LN+1
+6 SET ARRAY(LN,1)="VA-COVID-19 CPRS STATUS"
+7 IF MODE["I"
SET ARRAY(LN,2)="04/15/2020@11:51:56"
+8 IF MODE["A"
SET ARRAY(LN,3)="O"
+9 QUIT
+10 ;
FINDOI(RESULT) ;
+1 NEW CNODE,IDX,IEN,NAME,NODE,PIEN,PNODE
+2 SET NAME="COVID"
+3 FOR
SET NAME=$ORDER(^ORD(101.43,"S.LAB",NAME))
if NAME=""!(NAME'["COVID")
QUIT
Begin DoDot:1
+4 IF $PIECE(NAME," ")'="COVID-19"
QUIT
+5 SET IEN=+$ORDER(^ORD(101.43,"S.LAB",NAME,""))
if IEN=0
QUIT
+6 SET NODE=$GET(^ORD(101.43,IEN,0))
+7 IF $PIECE(NODE,U,2)'[";99LRT"
QUIT
+8 ;process child orderable items for panel
+9 IF $DATA(^ORD(101.43,IEN,10))
Begin DoDot:2
+10 SET IDX=0
FOR
SET IDX=$ORDER(^ORD(101.43,IEN,10,IDX))
if IDX'>0
QUIT
Begin DoDot:3
+11 SET CNODE=$GET(^ORD(101.43,IEN,10,IDX,0))
+12 SET PIEN=$ORDER(^ORD(101.43,"B",$PIECE(CNODE,U),""))
if PIEN'>0
QUIT
+13 SET PNODE=$GET(^ORD(101.43,PIEN,0))
+14 IF $PIECE(PNODE,U,2)'[";99LRT"
QUIT
+15 SET RESULT(PIEN,"NAME")=$PIECE(PNODE,U)
+16 SET RESULT(PIEN,"LAB")=$PIECE(PNODE,U,1,2)
End DoDot:3
+17 SET RESULT(IEN,"NAME")=$PIECE(NODE,U)
End DoDot:2
QUIT
+18 SET RESULT(IEN,"NAME")=$PIECE(NODE,U)
+19 SET RESULT(IEN,"LAB")=$PIECE(NODE,U,1,2)
End DoDot:1
+20 QUIT
+21 QUIT
+22 ;
+23 ;==========================================
PRE ;Pre-init
+1 ;Disable options and protocols
+2 ;D OPTION^PXRMUTIL("DISABLE")
+3 ;D PROTOCOL^PXRMUTIL("DISABLE")
+4 DO DELEXE^PXRMEXSI("EXARRAY","PXRMP72I")
+5 QUIT
+6 ;
+7 ;==========================================
POST ;Post-init
+1 ;Install Exchange File entries.
+2 DO SMEXINS^PXRMEXSI("EXARRAY","PXRMP72I")
+3 DO SETTERMS
+4 ;D OPTION^PXRMUTIL("ENABLE")
+5 ;D PROTOCOL^PXRMUTIL("ENABLE")
+6 DO SENDIM^PXRMMSG("PXRM*2.0*72")
+7 QUIT
+8 ;
+9 ;
SETTERMS ;
+1 NEW ARRAY,CNT,IEN,LAB,NODE,RIEN,ORDER,RESULT,TIEN,TERMS,TEXT
+2 NEW PXRMINST
+3 SET PXRMINST=1
+4 DO FINDOI(.ARRAY)
+5 SET CNT=0
SET IEN=0
+6 FOR
SET IEN=$ORDER(ARRAY(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+7 SET CNT=CNT+1
+8 ;set orders and order statuses
+9 SET ORDER(CNT,.01)="OI."_ARRAY(IEN,"NAME")
+10 ;set lab findings
+11 IF $PIECE($GET(ARRAY(IEN,"LAB")),U)'=""
SET LAB(CNT,.01)="LT."_$PIECE(ARRAY(IEN,"LAB"),U)
End DoDot:1
+12 ;update findings per term
+13 IF $DATA(ORDER)
Begin DoDot:1
+14 IF '$$OKTOUPD("VA-COVID-19 PCR LAB ORDERS")
QUIT
+15 DO SETTFIND^PXRMTUTL(.RESULT,"VA-COVID-19 PCR LAB ORDERS",.ORDER)
+16 IF +RESULT=-1
DO WRITERR("VA-COVID-19 PCR LAB ORDERS",RESULT)
QUIT
End DoDot:1
+17 IF $DATA(LAB)
Begin DoDot:1
+18 IF '$$OKTOUPD("VA-COVID-19 PCR LAB RESULTS NEGATIVE")
QUIT
+19 DO SETTFIND^PXRMTUTL(.RESULT,"VA-COVID-19 PCR LAB RESULTS NEGATIVE",.LAB)
+20 IF +RESULT=-1
DO WRITERR("VA-COVID-19 PCR LAB RESULTS NEGATIVE",RESULT)
+21 ;
+22 IF '$$OKTOUPD("VA-COVID-19 PCR LAB RESULTS POSITIVE")
QUIT
+23 DO SETTFIND^PXRMTUTL(.RESULT,"VA-COVID-19 PCR LAB RESULTS POSITIVE",.LAB)
+24 IF +RESULT=-1
DO WRITERR("VA-COVID-19 PCR LAB RESULTS POSITIVE",RESULT)
End DoDot:1
+25 ;
+26 ;Report terms that need to be reviewed.
+27 SET TEXT(1)="Forward the list of reminder terms to the CACs"
+28 SET TEXT(2)="to review the following reminder terms setup for any"
+29 SET TEXT(3)="missing lab tests or orders"
+30 SET TEXT(4)=" VA-COVID-19 PCR LAB RESULTS NEGATIVE"
+31 SET TEXT(5)=" VA-COVID-19 PCR LAB RESULTS POSITIVE"
+32 SET TEXT(6)=" VA-COVID-19 PCR LAB ORDERS"
+33 DO MES^XPDUTL(.TEXT)
+34 QUIT
+35 ;
OKTOUPD(TNAME) ;
+1 NEW RESULT,TIEN,TEXT
+2 SET RESULT=1
+3 SET TIEN=$ORDER(^PXRMD(811.5,"B",TNAME,""))
+4 IF 'TIEN
Begin DoDot:1
+5 SET TEXT(1)="ERROR: could not found reminder term:"
+6 SET TEXT(2)=" "_TNAME
+7 DO MES^XPDUTL(.TEXT)
+8 SET RESULT=0
End DoDot:1
QUIT
+9 IF RESULT
IF $DATA(^PXRMD(811.5,TIEN,20,"B"))
SET RESULT=0
+10 QUIT RESULT
+11 ;
WRITERR(TNAME,RESULT) ;
+1 NEW TEXT
+2 SET TEXT(1)="ERROR: mapping findings"
+3 SET TEXT(2)="Reminder Term: "_TNAME
+4 SET TEXT(3)=" "_$PIECE(RESULT,U,2)
+5 DO MES^XPDUTL(.TEXT)
+6 QUIT
