- PSGWODP ;BHAM ISC/PTD,CML-Print an On-Demand Report by Date/AOU ; 17 Aug 93 / 8:49 AM
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- BDT S %DT="AEXT",%DT("A")="BEGINNING date for report: " D ^%DT K %DT G:Y<0 END S BDT=Y,BDT=BDT-.1
- EDT S %DT="AEXT",%DT(0)=BDT,%DT("A")="ENDING date for report: " D ^%DT K %DT G:Y<0 END S EDT=Y,EDT=EDT+.3
- EN D SEL^PSGWUTL1 G:'$D(SEL) END G:SEL="I" EN2
- ASKAOU ;
- F JJ=0:0 S DIC="^PSI(58.1,",DIC(0)="QEAM" D ^DIC K DIC Q:Y<0 S AOULP(+Y)=""
- I '$D(AOULP)&(X'="^ALL") G END
- I X="^ALL" F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU S AOULP(AOU)=""
- EN2 G:'$D(AOULP) END W !!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
- DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END
- I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^PSGWODP",ZTDESC="Print On-Demand Request" S:$D(AOULP) ZTSAVE("AOULP(")="" F G="BDT","EDT","SEL","IGDA" S:$D(@G) ZTSAVE(G)=""
- I D ^%ZTLOAD,HOME^%ZIS K ZTSK G END
- U IO
- ;
- ENQ ;ENTRY POINT WHEN QUEUED
- K ^TMP("PSGWOD",$J) S AOU=0
- AOU I $D(AOULP) S AOU=$O(AOULP(AOU)) I 'AOU D PRINT^PSGWODPR G DONE
- I '$D(AOULP) S AOU=$O(^PSI(58.1,AOU)) I 'AOU D PRINT^PSGWODPR G DONE
- DRUG ;LOOP THROUGH DRUGS FOR AOU
- S DRGDA=0
- DRGLP S DRGDA=$O(^PSI(58.1,AOU,1,DRGDA)) G:'DRGDA AOU D OD G DRGLP
- ;
- OD ;ON DEMAND REQUESTS
- Q:'$O(^PSI(58.1,AOU,1,DRGDA,5,0)) S ODA=0
- ODLP S ODA=$O(^PSI(58.1,AOU,1,DRGDA,5,ODA)) Q:'ODA S LOC=^(ODA,0),ODT=$P(LOC,"^") I (ODT<BDT)!(ODT>EDT) G ODLP
- S QD=$P(LOC,"^",2),EDUZ=$S($P(LOC,"^",3)'="":$P(LOC,"^",3),1:"NOT LISTED"),DRGNM=$P(^PSI(58.1,AOU,1,DRGDA,0),"^"),STAN=$S($P(^(0),"^",3)="":0,$P(^(0),"^",3)>DT:0,1:1)
- S LEDUZ=$S(+$P(LOC,"^",5):$P(LOC,"^",5),1:"N/A"),LEDT=$S(+$P(LOC,"^",6):$P(LOC,"^",6),1:"N/A") D BACKORD
- I '$O(^PSDRUG(DRGNM,0)) S DIK="^PSI(58.1,"_AOU_",1,",DA=DRGDA,DA(1)=AOU D ^DIK K DIK G ODLP
- S DRGNAME=$P(^PSDRUG(DRGNM,0),"^"),^TMP("PSGWOD",$J,$P(ODT,"."),AOU,EDUZ,ODT,DRGNAME)=QD_"^"_STAN_"^"_DRGDA_"^"_BOTOT_"^"_LEDUZ_"^"_LEDT G ODLP
- DONE I $E(IOST)'="C" W @IOF
- I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
- END K EDITDT,PREV,ZTSK,^TMP("PSGWOD",$J),AOULP,JJ,ANS,AOU,BDT,DRGDA,DRGNAME,DRGNM,EDT,EDUZ,J,LEDT,LEDUZ,LOC,ODA,ODT,PGCT,QD,STAN,PSGDA,ADT,CAT,PSGWDT,PSGWODT,PSGWAOU,AMISFL,KEY,ODTM,TMDT,%,%I,%H,DA,G,D,DIE
- K %DT,%W,C,SEL,IGDA,D0,D1,D2,DI,DIC,DIYS,DLAYGO,DQ,IO("Q"),PSGWV,BOTOT,X,Y,BO,QFLG,PSGWDUZ,PRTFLG,PSGWDT,PSGWCAT,BON,ALL,BCFLG,NEWI,PSGDR,PSGWADT,PSGWD,PSGWDN D ^%ZISC
- S:$D(ZTQUEUED) ZTREQ="@" Q
- BACKORD ;TOTAL ANY BACKORDERS
- S X=DRGNM,BOTOT=0,DIC="^PSI(58.3,",DIC(0)="" D ^DIC Q:Y<0 S BO=+Y F J=0:0 S J=$S($D(^PSI(58.3,BO,1,AOU,1,J)):$O(^(J)),1:"") Q:'J S:$S($P(^(J,0),"^",5)="":1,1:0) BOTOT=BOTOT+$P(^(0),"^",2)
- Q
- PSGWODP ;BHAM ISC/PTD,CML-Print an On-Demand Report by Date/AOU ; 17 Aug 93 / 8:49 AM
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- BDT SET %DT="AEXT"
- SET %DT("A")="BEGINNING date for report: "
- DO ^%DT
- KILL %DT
- IF Y<0
- GOTO END
- SET BDT=Y
- SET BDT=BDT-.1
- EDT SET %DT="AEXT"
- SET %DT(0)=BDT
- SET %DT("A")="ENDING date for report: "
- DO ^%DT
- KILL %DT
- IF Y<0
- GOTO END
- SET EDT=Y
- SET EDT=EDT+.3
- EN DO SEL^PSGWUTL1
- IF '$DATA(SEL)
- GOTO END
- IF SEL="I"
- GOTO EN2
- ASKAOU ;
- +1 FOR JJ=0:0
- SET DIC="^PSI(58.1,"
- SET DIC(0)="QEAM"
- DO ^DIC
- KILL DIC
- IF Y<0
- QUIT
- SET AOULP(+Y)=""
- +2 IF '$DATA(AOULP)&(X'="^ALL")
- GOTO END
- +3 IF X="^ALL"
- FOR AOU=0:0
- SET AOU=$ORDER(^PSI(58.1,AOU))
- IF 'AOU
- QUIT
- SET AOULP(AOU)=""
- EN2 IF '$DATA(AOULP)
- GOTO END
- WRITE !!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
- DEV KILL %ZIS,IOP
- SET %ZIS="QM"
- SET %ZIS("B")=""
- DO ^%ZIS
- IF POP
- WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
- GOTO END
- +1 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="ENQ^PSGWODP"
- SET ZTDESC="Print On-Demand Request"
- IF $DATA(AOULP)
- SET ZTSAVE("AOULP(")=""
- FOR G="BDT","EDT","SEL","IGDA"
- IF $DATA(@G)
- SET ZTSAVE(G)=""
- +2 IF $TEST
- DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- GOTO END
- +3 USE IO
- +4 ;
- ENQ ;ENTRY POINT WHEN QUEUED
- +1 KILL ^TMP("PSGWOD",$JOB)
- SET AOU=0
- AOU IF $DATA(AOULP)
- SET AOU=$ORDER(AOULP(AOU))
- IF 'AOU
- DO PRINT^PSGWODPR
- GOTO DONE
- +1 IF '$DATA(AOULP)
- SET AOU=$ORDER(^PSI(58.1,AOU))
- IF 'AOU
- DO PRINT^PSGWODPR
- GOTO DONE
- DRUG ;LOOP THROUGH DRUGS FOR AOU
- +1 SET DRGDA=0
- DRGLP SET DRGDA=$ORDER(^PSI(58.1,AOU,1,DRGDA))
- IF 'DRGDA
- GOTO AOU
- DO OD
- GOTO DRGLP
- +1 ;
- OD ;ON DEMAND REQUESTS
- +1 IF '$ORDER(^PSI(58.1,AOU,1,DRGDA,5,0))
- QUIT
- SET ODA=0
- ODLP SET ODA=$ORDER(^PSI(58.1,AOU,1,DRGDA,5,ODA))
- IF 'ODA
- QUIT
- SET LOC=^(ODA,0)
- SET ODT=$PIECE(LOC,"^")
- IF (ODT<BDT)!(ODT>EDT)
- GOTO ODLP
- +1 SET QD=$PIECE(LOC,"^",2)
- SET EDUZ=$SELECT($PIECE(LOC,"^",3)'="":$PIECE(LOC,"^",3),1:"NOT LISTED")
- SET DRGNM=$PIECE(^PSI(58.1,AOU,1,DRGDA,0),"^")
- SET STAN=$SELECT($PIECE(^(0),"^",3)="":0,$PIECE(^(0),"^",3)>DT:0,1:1)
- +2 SET LEDUZ=$SELECT(+$PIECE(LOC,"^",5):$PIECE(LOC,"^",5),1:"N/A")
- SET LEDT=$SELECT(+$PIECE(LOC,"^",6):$PIECE(LOC,"^",6),1:"N/A")
- DO BACKORD
- +3 IF '$ORDER(^PSDRUG(DRGNM,0))
- SET DIK="^PSI(58.1,"_AOU_",1,"
- SET DA=DRGDA
- SET DA(1)=AOU
- DO ^DIK
- KILL DIK
- GOTO ODLP
- +4 SET DRGNAME=$PIECE(^PSDRUG(DRGNM,0),"^")
- SET ^TMP("PSGWOD",$JOB,$PIECE(ODT,"."),AOU,EDUZ,ODT,DRGNAME)=QD_"^"_STAN_"^"_DRGDA_"^"_BOTOT_"^"_LEDUZ_"^"_LEDT
- GOTO ODLP
- DONE IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST)="C"
- IF 'QFLG
- DO SS^PSGWUTL1
- END KILL EDITDT,PREV,ZTSK,^TMP("PSGWOD",$JOB),AOULP,JJ,ANS,AOU,BDT,DRGDA,DRGNAME,DRGNM,EDT,EDUZ,J,LEDT,LEDUZ,LOC,ODA,ODT,PGCT,QD,STAN,PSGDA,ADT,CAT,PSGWDT,PSGWODT,PSGWAOU,AMISFL,KEY,ODTM,TMDT,%,%I,%H,DA,G,D,DIE
- +1 KILL %DT,%W,C,SEL,IGDA,D0,D1,D2,DI,DIC,DIYS,DLAYGO,DQ,IO("Q"),PSGWV,BOTOT,X,Y,BO,QFLG,PSGWDUZ,PRTFLG,PSGWDT,PSGWCAT,BON,ALL,BCFLG,NEWI,PSGDR,PSGWADT,PSGWD,PSGWDN
- DO ^%ZISC
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- BACKORD ;TOTAL ANY BACKORDERS
- +1 SET X=DRGNM
- SET BOTOT=0
- SET DIC="^PSI(58.3,"
- SET DIC(0)=""
- DO ^DIC
- IF Y<0
- QUIT
- SET BO=+Y
- FOR J=0:0
- SET J=$SELECT($DATA(^PSI(58.3,BO,1,AOU,1,J)):$ORDER(^(J)),1:"")
- IF 'J
- QUIT
- IF $SELECT($PIECE(^(J,0),"^",5)=""
- SET BOTOT=BOTOT+$PIECE(^(0),"^",2)
- +2 QUIT
