PSGWCAD3.m

PSGWCAD3 ;BHAM ISC/CML-Check for non-pharmacy items in AOUs before updating AMIS Stats ; 12/18/90 14:10

 ;;2.3; Automatic Replenishment/Ward Stock ;**17**;4 JAN 94

START ;Locate all non-pharmacy items in Drug file

 K APP,AOU,ERR3 S (AOUCNT,DRGCNT)=0

 S APP="" F JJ=0:0 S APP=$O(^PSDRUG("IU",APP)) Q:APP=""  I APP'["O"&(APP'["U")&(APP'["I")&(APP'["N")&(APP'["X") F DRG=0:0 S DRG=$O(^PSDRUG("IU",APP,DRG)) Q:'DRG  S APP(DRG)=""

 Q

AOU ;Check AOUs for non-pharmacy items

 G:'$O(APP(0)) QUIT F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU  I $S('$D(^PSI(58.1,AOU,"I")):1,'^("I"):1,^("I")>DT:1,1:0) S AOU(AOU)=""

 G:'$O(AOU(0)) QUIT F AOU=0:0 S AOU=$O(AOU(AOU)) Q:'AOU  F ITM=0:0 S ITM=$O(^PSI(58.1,AOU,1,ITM)) Q:'ITM  S ITMNUM=$P(^PSI(58.1,AOU,1,ITM,0),"^") I $D(APP(ITMNUM)) D CHK

 I $D(ERR3) D MAIL

QUIT K %,%H,%I,AOU,AOUCNT,APP,CNT,DRG,DRGCNT,ERR3,I,INACT,ITM,ITMNUM,J,JJ,K,NUM,PRT1,PRT2,PRT3,PSGWDUZ,RDT,X,XMDUZ,XMKK,XMLOCK,XMR,XMSUB,XMT,XMTEXT,XMY,XMZ,Y,^TMP("PSGWMSG",$J) Q

CHK ;Check non-pharmacy items for inactivation date in AOU

 ;ERR3(ITMNUM,AOU)=""

 S INACT=$P(^PSI(58.1,AOU,1,ITM,0),"^",3) I $S('INACT:1,INACT>DT:1,1:0) S ERR3(ITMNUM,AOU)=""

 Q

MAIL ;Send message for non-pharmacy items found in AOUs

 Q:'$O(ERR3(0))  S NUM=6,CNT=0 F JJ=0:0 S JJ=$O(ERR3(JJ)) Q:'JJ  S DRGCNT=DRGCNT+1 F KK=0:0 S KK=$O(ERR3(JJ,KK)) Q:'KK  S AOUCNT=AOUCNT+1

 K XMY,^TMP("PSGWMSG",$J) D NOW^%DTC S Y=X X ^DD("DD") S RDT=Y

 F PSGWDUZ=0:0 S PSGWDUZ=$O(^XUSEC("PSGWMGR",PSGWDUZ)) Q:'PSGWDUZ  S XMY(PSGWDUZ)=""

 I '$D(XMY) F PSGWDUZ=0:0 S PSGWDUZ=$O(^XUSEC("PSGW PARAM",PSGWDUZ)) Q:'PSGWDUZ  S XMY(PSGWDUZ)=""

 S:'$D(XMY) XMY(.5)="" S PRT1=$S(AOUCNT>1:"AOUs",1:"AOU"),PRT2=$S(DRGCNT>1:"items",1:"item"),$P(PRT3,"-",78)=""

 S ^TMP("PSGWMSG",$J,1,0)="On "_RDT_", the nightly job to update the AR/WS AMIS Stats file (#58.5)"

 S ^TMP("PSGWMSG",$J,2,0)="identified the following "_PRT2_" in the following "_PRT1_" that "_$S(DRGCNT>1:"have",1:"has")_" been marked"

 S ^TMP("PSGWMSG",$J,3,0)="in the Drug file (#50) for NON-PHARMACY use.",^TMP("PSGWMSG",$J,4,0)=""

 S ^TMP("PSGWMSG",$J,5,0)="ITEM           AOU",^TMP("PSGWMSG",$J,6,0)=PRT3

 F DRG=0:0 S DRG=$O(ERR3(DRG)) Q:'DRG  S NUM=NUM+1,CNT=CNT+1 S ^TMP("PSGWMSG",$J,NUM,0)=CNT_"."_" "_$P(^PSDRUG(DRG,0),"^") F AOU=0:0 S AOU=$O(ERR3(DRG,AOU)) Q:'AOU  D SET

 S NUM=NUM+1,^TMP("PSGWMSG",$J,NUM,0)="",NUM=NUM+1,^TMP("PSGWMSG",$J,NUM,0)="It will be necessary to either inactivate "_$S(DRGCNT>1:"these ",1:"this ")_PRT2_" in the "_PRT1_" or mark"

 S NUM=NUM+1,^TMP("PSGWMSG",$J,NUM,0)="the "_PRT2_" for PHARMACY use in the Drug file.  For further explanation, please"

 S NUM=NUM+1,^TMP("PSGWMSG",$J,NUM,0)="refer to item #7 ([PSGW UPDATE AMIS STATS]) under the Supervisor's Menu in"

 S NUM=NUM+1,^TMP("PSGWMSG",$J,NUM,0)="the AR/WS version 2.2 USER MANUAL."

 S XMSUB="NON-PHARMACY ITEMS FOUND",XMDUZ="INPATIENT PHARMACY AR/WS",XMTEXT="^TMP(""PSGWMSG"",$J," D ^XMD

 Q

SET ;

 S NUM=NUM+1,^TMP("PSGWMSG",$J,NUM,0)="               "_$P(^PSI(58.1,AOU,0),"^") Q

PSGWCAD3  ;BHAM ISC/CML-Check for non-pharmacy items in AOUs before updating AMIS Stats ; 12/18/90 14:10

 +1       ;;2.3; Automatic Replenishment/Ward Stock ;**17**;4 JAN 94

START     ;Locate all non-pharmacy items in Drug file

 +1        KILL APP,AOU,ERR3

           SET (AOUCNT,DRGCNT)=0

 +2        SET APP=""

           FOR JJ=0:0

               SET APP=$ORDER(^PSDRUG("IU",APP))

               IF APP=""

                   QUIT 

               IF APP'["O"&(APP'["U")&(APP'["I")&(APP'["N")&(APP'["X")

                   FOR DRG=0:0

                       SET DRG=$ORDER(^PSDRUG("IU",APP,DRG))

                       IF 'DRG

                           QUIT 

                       SET APP(DRG)=""

 +3        QUIT 

AOU       ;Check AOUs for non-pharmacy items

 +1        IF '$ORDER(APP(0))

               GOTO QUIT

           FOR AOU=0:0

               SET AOU=$ORDER(^PSI(58.1,AOU))

               IF 'AOU

                   QUIT 

               IF $SELECT('$DATA(^PSI(58.1,AOU,"I")):1,'^("I"):1,^("I")>DT:1,1:0)

                   SET AOU(AOU)=""

 +2        IF '$ORDER(AOU(0))

               GOTO QUIT

           FOR AOU=0:0

               SET AOU=$ORDER(AOU(AOU))

               IF 'AOU

                   QUIT 

               FOR ITM=0:0

                   SET ITM=$ORDER(^PSI(58.1,AOU,1,ITM))

                   IF 'ITM

                       QUIT 

                   SET ITMNUM=$PIECE(^PSI(58.1,AOU,1,ITM,0),"^")

                   IF $DATA(APP(ITMNUM))

                       DO CHK

 +3        IF $DATA(ERR3)

               DO MAIL

QUIT       KILL %,%H,%I,AOU,AOUCNT,APP,CNT,DRG,DRGCNT,ERR3,I,INACT,ITM,ITMNUM,J,JJ,K,NUM,PRT1,PRT2,PRT3,PSGWDUZ,RDT,X,XMDUZ,XMKK,XMLOCK,XMR,XMSUB,XMT,XMTEXT,XMY,XMZ,Y,^TMP("PSGWMSG",$JOB)

           QUIT 

CHK       ;Check non-pharmacy items for inactivation date in AOU

 +1       ;ERR3(ITMNUM,AOU)=""

 +2        SET INACT=$PIECE(^PSI(58.1,AOU,1,ITM,0),"^",3)

           IF $SELECT('INACT:1,INACT>DT:1,1:0)

               SET ERR3(ITMNUM,AOU)=""

 +3        QUIT 

MAIL      ;Send message for non-pharmacy items found in AOUs

 +1        IF '$ORDER(ERR3(0))

               QUIT 

           SET NUM=6

           SET CNT=0

           FOR JJ=0:0

               SET JJ=$ORDER(ERR3(JJ))

               IF 'JJ

                   QUIT 

               SET DRGCNT=DRGCNT+1

               FOR KK=0:0

                   SET KK=$ORDER(ERR3(JJ,KK))

                   IF 'KK

                       QUIT 

                   SET AOUCNT=AOUCNT+1

 +2        KILL XMY,^TMP("PSGWMSG",$JOB)

           DO NOW^%DTC

           SET Y=X

           XECUTE ^DD("DD")

           SET RDT=Y

 +3        FOR PSGWDUZ=0:0

               SET PSGWDUZ=$ORDER(^XUSEC("PSGWMGR",PSGWDUZ))

               IF 'PSGWDUZ

                   QUIT 

               SET XMY(PSGWDUZ)=""

 +4        IF '$DATA(XMY)

               FOR PSGWDUZ=0:0

                   SET PSGWDUZ=$ORDER(^XUSEC("PSGW PARAM",PSGWDUZ))

                   IF 'PSGWDUZ

                       QUIT 

                   SET XMY(PSGWDUZ)=""

 +5        IF '$DATA(XMY)

               SET XMY(.5)=""

           SET PRT1=$SELECT(AOUCNT>1:"AOUs",1:"AOU")

           SET PRT2=$SELECT(DRGCNT>1:"items",1:"item")

           SET $PIECE(PRT3,"-",78)=""

 +6        SET ^TMP("PSGWMSG",$JOB,1,0)="On "_RDT_", the nightly job to update the AR/WS AMIS Stats file (#58.5)"

 +7        SET ^TMP("PSGWMSG",$JOB,2,0)="identified the following "_PRT2_" in the following "_PRT1_" that "_$SELECT(DRGCNT>1:"have",1:"has")_" been marked"

 +8        SET ^TMP("PSGWMSG",$JOB,3,0)="in the Drug file (#50) for NON-PHARMACY use."

           SET ^TMP("PSGWMSG",$JOB,4,0)=""

 +9        SET ^TMP("PSGWMSG",$JOB,5,0)="ITEM           AOU"

           SET ^TMP("PSGWMSG",$JOB,6,0)=PRT3

 +10       FOR DRG=0:0

               SET DRG=$ORDER(ERR3(DRG))

               IF 'DRG

                   QUIT 

               SET NUM=NUM+1

               SET CNT=CNT+1

               SET ^TMP("PSGWMSG",$JOB,NUM,0)=CNT_"."_" "_$PIECE(^PSDRUG(DRG,0),"^")

               FOR AOU=0:0

                   SET AOU=$ORDER(ERR3(DRG,AOU))

                   IF 'AOU

                       QUIT 

                   DO SET

 +11       SET NUM=NUM+1

           SET ^TMP("PSGWMSG",$JOB,NUM,0)=""

           SET NUM=NUM+1

           SET ^TMP("PSGWMSG",$JOB,NUM,0)="It will be necessary to either inactivate "_$SELECT(DRGCNT>1:"these ",1:"this ")_PRT2_" in the "_PRT1_" or mark"

 +12       SET NUM=NUM+1

           SET ^TMP("PSGWMSG",$JOB,NUM,0)="the "_PRT2_" for PHARMACY use in the Drug file.  For further explanation, please"

 +13       SET NUM=NUM+1

           SET ^TMP("PSGWMSG",$JOB,NUM,0)="refer to item #7 ([PSGW UPDATE AMIS STATS]) under the Supervisor's Menu in"

 +14       SET NUM=NUM+1

           SET ^TMP("PSGWMSG",$JOB,NUM,0)="the AR/WS version 2.2 USER MANUAL."

 +15       SET XMSUB="NON-PHARMACY ITEMS FOUND"

           SET XMDUZ="INPATIENT PHARMACY AR/WS"

           SET XMTEXT="^TMP(""PSGWMSG"",$J,"

           DO ^XMD

 +16       QUIT 

SET       ;

 +1        SET NUM=NUM+1

           SET ^TMP("PSGWMSG",$JOB,NUM,0)="               "_$PIECE(^PSI(58.1,AOU,0),"^")

           QUIT