PXRMSTA2 ; SLC/AGP - Routines for building status list. ;12/19/2012
;;2.0;CLINICAL REMINDERS;**4,6,26**;Feb 04, 2005;Build 404
;
ARRAYFOR(ARRAY,OUTPUT,DEF) ;
;Format the data array into a standard format
N CNT,COMP,PIECE,STR,TYPE
S PIECE=0
;Determine the number of pieces minus one in the string
F CNT=1:1:$L(ARRAY("POINTER")) I $E(ARRAY("POINTER"),CNT)=";" S PIECE=PIECE+1 I PIECE>0 D
. S STR=$P($P($G(ARRAY("POINTER")),";",PIECE),":",2)
. S OUTPUT($P($P($G(ARRAY("POINTER")),";",PIECE),":",2))=STR_U_$G(DEF)
;
;Add last piece in the string to the array
I PIECE>0 S PIECE=PIECE+1 D
. I $P($G(ARRAY("POINTER")),";",PIECE)'="" D
.. S OUTPUT($P($P($G(ARRAY("POINTER")),";",PIECE),":",2))=$P($P($G(ARRAY("POINTER")),";",PIECE),":",2)_U_$G(DEF)
Q
;
COMPARE(ARRAY,ARRAY1,TYPE,OUTPUT) ;
;This sub routine is used to combine both Pharmacy types into one array
N ARY,CNT,COMP,NODE
K OUTPUT
S COMP=""
;
;Inpatient pharmacy list is built from two separated fields in file #55
;this is used to combine the two fields into one array
I $G(TYPE)="I" D
. F S COMP=$O(ARRAY(COMP)) Q:COMP="" S OUTPUT(COMP)=ARRAY(COMP)
. S (COMP)="" F S COMP=$O(ARRAY1(COMP)) Q:COMP="" I '$D(OUTPUT(COMP)) S OUTPUT(COMP)=ARRAY1(COMP)
;
;This section combines the different RX Types into one array
I $G(TYPE)'="I" D
. F S COMP=$O(ARRAY(COMP)) Q:COMP="" D
.. S NODE=$G(ARRAY(COMP))
.. S OUTPUT(COMP)=NODE
. S COMP="" F S COMP=$O(ARRAY1(COMP)) Q:COMP="" D
.. S NODE=$G(ARRAY1(COMP))
.. I '$D(OUTPUT(COMP)) S OUTPUT(COMP)=NODE Q
.. I $D(OUTPUT(COMP)) S $P(OUTPUT(COMP),U,2)=$P(OUTPUT(COMP),U,2)_$P(NODE,U,2)
Q
;
DATA(FILE,DA,TYPE,RXTYPE,STATUS) ;
;Get the list of statuses from the appopriate global
N ARRAY,ARRAY1,CNT,CODE,DEF,OUTPUT,SARRAY,STAT
LOOP ;
;Get build status list into a local array from each pharmacy type of
;finding item
I TYPE="DRUG" D
. I $D(RXTYPE("I"))>0 D
..;DBIA #4928
.. D STATUS^PSS55MIS(55.06,28,"SARRAY")
.. D ARRAYFOR(.SARRAY,.ARRAY,"I") K CODE
.. D STATUS^PSS55MIS(55.01,100,"SARRAY")
.. D ARRAYFOR(.SARRAY,.ARRAY1,"I") K CODE
.. D COMPARE(.ARRAY,.ARRAY1,"I",.OUTPUT)
. I $D(RXTYPE("O"))>0 D
.. K ARRAY,ARRAY1,CODE
..;DBIA #4848
.. D STATUS^PSODI(52,100,"SARRAY")
.. D ARRAYFOR(.SARRAY,.ARRAY,"O") K CODE
.. I $D(OUTPUT)>0 K ARRAY1 M ARRAY1=OUTPUT K OUTPUT D COMPARE(.ARRAY,.ARRAY1,"",.OUTPUT)
.. E M OUTPUT=ARRAY
. I $D(RXTYPE("N"))>0 D
.. K ARRAY,ARRAY1,CODE
.. D STATUS^PSS55MIS(55.05,5,"SARRAY")
.. S SARRAY("POINTER")=SARRAY("POINTER")_"0:ACTIVE;"
.. D ARRAYFOR(.SARRAY,.ARRAY,"N") K CODE
.. I $D(OUTPUT)>0 K ARRAY1 M ARRAY1=OUTPUT K OUTPUT D COMPARE(.ARRAY,.ARRAY1,"",.OUTPUT)
.. E M OUTPUT=ARRAY
;
I TYPE="PROB" S OUTPUT("ACTIVE")="ACTIVE",OUTPUT("INACTIVE")="INACTIVE"
I TYPE="ORD(101.43," D
.;DBIA #??
. S CNT=0,STAT="" F S STAT=$O(^ORD(100.01,"B",STAT)) Q:STAT="" D
.. S CNT=CNT+1 S OUTPUT(STAT)=STAT
I TYPE="RAMIS(71,"!(TYPE="TAX") D
. S TYPE="RAMIS(71,"
.;DBIA #996
. S CNT=0,STAT="" F S STAT=$O(^RA(72,"B",STAT)) Q:STAT="" D
.. S CNT=CNT+1 S OUTPUT(STAT)=STAT
D SELECT(.OUTPUT,FILE,TYPE,.STATUS,.DA)
Q
;
SELECT(ARRAY,FILE,TYPE,STATUS,DA) ;
;Sort through the formated array and set up the DIR call
N CHECK,CNT,CNT1,DIR,DUOUT,DTOUT,EMPTY,EXTR
N HELP,LENGTH,NODE,STAT,STR,TEXT,TMP,X,Y
N TMPARR,NUM
DISPLAY ;
I TYPE="DRUG" S TEXT="Select a Medication Status or enter '^' to Quit",HELP="Select a status from the Medication Status list or '^' to Quit"
I TYPE="ORD(101.43," S TEXT="Select a Order Status from or enter '^' to Quit",HELP="Select a Order Status from the status list or '^' to Quit"
I TYPE="RAMIS(71," S TEXT="Select a Radiology Procedure Status or enter '^' to Quit",HELP="Select a Radiology Procedure Status from the status list or '^' to Quit"
;
S CNT=0,CNT1=0,STAT=""
;If text is not entered into the prompt or no match is found display
;entire list of statuses for this finding item
;
;Add wildcard character
S CNT=CNT+1,CNT1=CNT1+1,TMP(CNT)=CNT_" - * (WildCard)",TMPARR(CNT)="*"
;Add status from file to the selectable list
F S STAT=$O(ARRAY(STAT)) Q:STAT="" D
. S NODE=$G(ARRAY(STAT))
. S STR=$P(NODE,U)
. S CNT=CNT+1,CNT1=CNT1+1
. I TYPE="DRUG" S TMP(CNT)=CNT_" - "_STR_"("_$P(NODE,U,2)_")",TMPARR(CNT)=STR
. E S TMP(CNT)=CNT_" - "_STR,TMPARR(CNT)=STR
;
S DIR(0)="LO^1:"_CNT_""
M DIR("A")=TMP
S DIR("A")=TEXT
S DIR("?")=HELP
D ^DIR
I $D(DTOUT)!($D(DUOUT))!($G(Y)="") K STATUS Q
S CNT=0 F X=1:1:$L(Y(0)) D
.I $E(Y(0),X)="," S CNT=CNT+1,NUM=$P(Y(0),",",CNT),STATUS(TMPARR(NUM))=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMSTA2 4644 printed Oct 16, 2024@17:50:05 Page 2
PXRMSTA2 ; SLC/AGP - Routines for building status list. ;12/19/2012
+1 ;;2.0;CLINICAL REMINDERS;**4,6,26**;Feb 04, 2005;Build 404
+2 ;
ARRAYFOR(ARRAY,OUTPUT,DEF) ;
+1 ;Format the data array into a standard format
+2 NEW CNT,COMP,PIECE,STR,TYPE
+3 SET PIECE=0
+4 ;Determine the number of pieces minus one in the string
+5 FOR CNT=1:1:$LENGTH(ARRAY("POINTER"))
IF $EXTRACT(ARRAY("POINTER"),CNT)=";"
SET PIECE=PIECE+1
IF PIECE>0
Begin DoDot:1
+6 SET STR=$PIECE($PIECE($GET(ARRAY("POINTER")),";",PIECE),":",2)
+7 SET OUTPUT($PIECE($PIECE($GET(ARRAY("POINTER")),";",PIECE),":",2))=STR_U_$GET(DEF)
End DoDot:1
+8 ;
+9 ;Add last piece in the string to the array
+10 IF PIECE>0
SET PIECE=PIECE+1
Begin DoDot:1
+11 IF $PIECE($GET(ARRAY("POINTER")),";",PIECE)'=""
Begin DoDot:2
+12 SET OUTPUT($PIECE($PIECE($GET(ARRAY("POINTER")),";",PIECE),":",2))=$PIECE($PIECE($GET(ARRAY("POINTER")),";",PIECE),":",2)_U_$GET(DEF)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
COMPARE(ARRAY,ARRAY1,TYPE,OUTPUT) ;
+1 ;This sub routine is used to combine both Pharmacy types into one array
+2 NEW ARY,CNT,COMP,NODE
+3 KILL OUTPUT
+4 SET COMP=""
+5 ;
+6 ;Inpatient pharmacy list is built from two separated fields in file #55
+7 ;this is used to combine the two fields into one array
+8 IF $GET(TYPE)="I"
Begin DoDot:1
+9 FOR
SET COMP=$ORDER(ARRAY(COMP))
if COMP=""
QUIT
SET OUTPUT(COMP)=ARRAY(COMP)
+10 SET (COMP)=""
FOR
SET COMP=$ORDER(ARRAY1(COMP))
if COMP=""
QUIT
IF '$DATA(OUTPUT(COMP))
SET OUTPUT(COMP)=ARRAY1(COMP)
End DoDot:1
+11 ;
+12 ;This section combines the different RX Types into one array
+13 IF $GET(TYPE)'="I"
Begin DoDot:1
+14 FOR
SET COMP=$ORDER(ARRAY(COMP))
if COMP=""
QUIT
Begin DoDot:2
+15 SET NODE=$GET(ARRAY(COMP))
+16 SET OUTPUT(COMP)=NODE
End DoDot:2
+17 SET COMP=""
FOR
SET COMP=$ORDER(ARRAY1(COMP))
if COMP=""
QUIT
Begin DoDot:2
+18 SET NODE=$GET(ARRAY1(COMP))
+19 IF '$DATA(OUTPUT(COMP))
SET OUTPUT(COMP)=NODE
QUIT
+20 IF $DATA(OUTPUT(COMP))
SET $PIECE(OUTPUT(COMP),U,2)=$PIECE(OUTPUT(COMP),U,2)_$PIECE(NODE,U,2)
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
DATA(FILE,DA,TYPE,RXTYPE,STATUS) ;
+1 ;Get the list of statuses from the appopriate global
+2 NEW ARRAY,ARRAY1,CNT,CODE,DEF,OUTPUT,SARRAY,STAT
LOOP ;
+1 ;Get build status list into a local array from each pharmacy type of
+2 ;finding item
+3 IF TYPE="DRUG"
Begin DoDot:1
+4 IF $DATA(RXTYPE("I"))>0
Begin DoDot:2
+5 ;DBIA #4928
+6 DO STATUS^PSS55MIS(55.06,28,"SARRAY")
+7 DO ARRAYFOR(.SARRAY,.ARRAY,"I")
KILL CODE
+8 DO STATUS^PSS55MIS(55.01,100,"SARRAY")
+9 DO ARRAYFOR(.SARRAY,.ARRAY1,"I")
KILL CODE
+10 DO COMPARE(.ARRAY,.ARRAY1,"I",.OUTPUT)
End DoDot:2
+11 IF $DATA(RXTYPE("O"))>0
Begin DoDot:2
+12 KILL ARRAY,ARRAY1,CODE
+13 ;DBIA #4848
+14 DO STATUS^PSODI(52,100,"SARRAY")
+15 DO ARRAYFOR(.SARRAY,.ARRAY,"O")
KILL CODE
+16 IF $DATA(OUTPUT)>0
KILL ARRAY1
MERGE ARRAY1=OUTPUT
KILL OUTPUT
DO COMPARE(.ARRAY,.ARRAY1,"",.OUTPUT)
+17 IF '$TEST
MERGE OUTPUT=ARRAY
End DoDot:2
+18 IF $DATA(RXTYPE("N"))>0
Begin DoDot:2
+19 KILL ARRAY,ARRAY1,CODE
+20 DO STATUS^PSS55MIS(55.05,5,"SARRAY")
+21 SET SARRAY("POINTER")=SARRAY("POINTER")_"0:ACTIVE;"
+22 DO ARRAYFOR(.SARRAY,.ARRAY,"N")
KILL CODE
+23 IF $DATA(OUTPUT)>0
KILL ARRAY1
MERGE ARRAY1=OUTPUT
KILL OUTPUT
DO COMPARE(.ARRAY,.ARRAY1,"",.OUTPUT)
+24 IF '$TEST
MERGE OUTPUT=ARRAY
End DoDot:2
End DoDot:1
+25 ;
+26 IF TYPE="PROB"
SET OUTPUT("ACTIVE")="ACTIVE"
SET OUTPUT("INACTIVE")="INACTIVE"
+27 IF TYPE="ORD(101.43,"
Begin DoDot:1
+28 ;DBIA #??
+29 SET CNT=0
SET STAT=""
FOR
SET STAT=$ORDER(^ORD(100.01,"B",STAT))
if STAT=""
QUIT
Begin DoDot:2
+30 SET CNT=CNT+1
SET OUTPUT(STAT)=STAT
End DoDot:2
End DoDot:1
+31 IF TYPE="RAMIS(71,"!(TYPE="TAX")
Begin DoDot:1
+32 SET TYPE="RAMIS(71,"
+33 ;DBIA #996
+34 SET CNT=0
SET STAT=""
FOR
SET STAT=$ORDER(^RA(72,"B",STAT))
if STAT=""
QUIT
Begin DoDot:2
+35 SET CNT=CNT+1
SET OUTPUT(STAT)=STAT
End DoDot:2
End DoDot:1
+36 DO SELECT(.OUTPUT,FILE,TYPE,.STATUS,.DA)
+37 QUIT
+38 ;
SELECT(ARRAY,FILE,TYPE,STATUS,DA) ;
+1 ;Sort through the formated array and set up the DIR call
+2 NEW CHECK,CNT,CNT1,DIR,DUOUT,DTOUT,EMPTY,EXTR
+3 NEW HELP,LENGTH,NODE,STAT,STR,TEXT,TMP,X,Y
+4 NEW TMPARR,NUM
DISPLAY ;
+1 IF TYPE="DRUG"
SET TEXT="Select a Medication Status or enter '^' to Quit"
SET HELP="Select a status from the Medication Status list or '^' to Quit"
+2 IF TYPE="ORD(101.43,"
SET TEXT="Select a Order Status from or enter '^' to Quit"
SET HELP="Select a Order Status from the status list or '^' to Quit"
+3 IF TYPE="RAMIS(71,"
SET TEXT="Select a Radiology Procedure Status or enter '^' to Quit"
SET HELP="Select a Radiology Procedure Status from the status list or '^' to Quit"
+4 ;
+5 SET CNT=0
SET CNT1=0
SET STAT=""
+6 ;If text is not entered into the prompt or no match is found display
+7 ;entire list of statuses for this finding item
+8 ;
+9 ;Add wildcard character
+10 SET CNT=CNT+1
SET CNT1=CNT1+1
SET TMP(CNT)=CNT_" - * (WildCard)"
SET TMPARR(CNT)="*"
+11 ;Add status from file to the selectable list
+12 FOR
SET STAT=$ORDER(ARRAY(STAT))
if STAT=""
QUIT
Begin DoDot:1
+13 SET NODE=$GET(ARRAY(STAT))
+14 SET STR=$PIECE(NODE,U)
+15 SET CNT=CNT+1
SET CNT1=CNT1+1
+16 IF TYPE="DRUG"
SET TMP(CNT)=CNT_" - "_STR_"("_$PIECE(NODE,U,2)_")"
SET TMPARR(CNT)=STR
+17 IF '$TEST
SET TMP(CNT)=CNT_" - "_STR
SET TMPARR(CNT)=STR
End DoDot:1
+18 ;
+19 SET DIR(0)="LO^1:"_CNT_""
+20 MERGE DIR("A")=TMP
+21 SET DIR("A")=TEXT
+22 SET DIR("?")=HELP
+23 DO ^DIR
+24 IF $DATA(DTOUT)!($DATA(DUOUT))!($GET(Y)="")
KILL STATUS
QUIT
+25 SET CNT=0
FOR X=1:1:$LENGTH(Y(0))
Begin DoDot:1
+26 IF $EXTRACT(Y(0),X)=","
SET CNT=CNT+1
SET NUM=$PIECE(Y(0),",",CNT)
SET STATUS(TMPARR(NUM))=""
End DoDot:1
+27 QUIT
+28 ;
