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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWCAD3 3012 printed Nov 22, 2024@16:49:16 Page 2
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
