Routine: PXRMSTA2

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)

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)

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)

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))=""

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      ;

PXRMSTA2.m