PSGWCL ;BHAM ISC/PTD,CML-Clear AMIS Exceptions ; 29 Dec 93 / 2:29 PM
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
W !!,"This option will show AR/WS drugs for which information is missing.",!,"The information MUST be supplied before the AMIS report can be printed.",!!
;GET DATES FOR AMIS REPORT
BDT S %DT="AEX",%DT("A")="BEGINNING date for AMIS report: " D ^%DT K %DT G:Y<0 END S BDT=Y
EDT S %DT="AEX",%DT(0)=BDT,%DT("A")="ENDING date for AMIS report: " D ^%DT K %DT G:Y<0 END S EDT=Y
I '$O(^PSI(58.5,"AEX",BDT-1)) W !!,"No AMIS exceptions for selected dates." G END
S QUEFLG=0 D ^PSGWCLP G:QUEFLG END
CONT W !!,"Do you wish to edit incomplete data now" S %=1 D YN^DICN I %<0!(%=2) G END
I '% W !?5,"Enter ""YES"" or ""NO""" G CONT
;LOOP THROUGH THE "AEX" CROSS-REFERENCE
S DATDA=(BDT-1),(SITE,DRGDA,INC,MSG)=0
DTLP S DATDA=$O(^PSI(58.5,"AEX",DATDA)),PSGWADT=$P(DATDA,".") G:(DATDA>EDT)!(DATDA="") MSG
STLP S SITE=$O(^PSI(58.5,"AEX",DATDA,SITE)) G:'SITE DTLP
DRGLP S DRGDA=$O(^PSI(58.5,"AEX",DATDA,SITE,DRGDA)) G:'DRGDA STLP
ASK ;ASK FOR MISSING DRUG DATA
S PSGWDN=$P(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,0),"^"),DRGNAM=$S($P($G(^PSDRUG(PSGWDN,0)),"^")'="":$P(^(0),"^"),1:"") I DRGNAM="" W !!,"The name for drug ",PSGWDN," is missing from the drug file.",!,"Notify your package coordinator!" G DRGLP
I $D(LOC(PSGWDN)) D CHK G DRGLP
W !!,"==> Information incomplete for: ",DRGNAM,!
S INC=1,DIE="^PSDRUG(",DA=PSGWDN,DR="13;15;301;302" D ^DIE K DIE G:$D(Y) MSG S LOC(PSGWDN)="" D CHK G DRGLP
CHK ;VERIFY THAT USER HAS ENTERED ALL NECESSARY DATA
I $D(^PSDRUG(PSGWDN,660)) S LOC1=^(660),INC=0
E S INC=1,MSG=1 Q
I $D(^PSDRUG(PSGWDN,"PSG")) S LOC2=^("PSG"),INC=0
E S INC=1,MSG=1 Q
F J=3,5,6 I $P(LOC1,"^",J)="" S INC=1,MSG=1 Q
F J=2,3 I $P(LOC2,"^",J)="" S INC=1,MSG=1 Q
I INC=0 D UPAMIS
Q
MSG I INC!(MSG) W *7,!!,"DATA IS STILL MISSING! YOU WILL NOT BE ABLE",!,"TO PRINT AMIS UNTIL INFORMATION IS COMPLETE!!"
E W !!,"DATA COMPLETE!!"
END K PSGWCAT,PSGWQD,X,Y,BDT,EDT,SITE,DATDA,DRGDA,DRGNAM,LOC1,LOC2,INC,J,PSGWDN,CAT,COST,DOSE,FLD,FLDA,LOC,LOC3,PSGWADT,PSGWAOU,DA,DR,%,D0,DI,DIG,DIH,DIU,DIV,DQ,DTDA,QUEFLG,G,MSG Q
;
UPAMIS ;UPDATE THE AMIS SUBFILE AND REMOVE INCOMPLETE FLAG & X-REF
I '$O(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",0)) D KILL Q
F CAT=0:0 S CAT=$O(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",CAT)) Q:'CAT S PSGWCAT=$P(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",CAT,0),"^"),PSGWQD=$P(^(0),"^",2) D UPDATE
Q
;
UPDATE I PSGWCAT["R" S LOC3="^"_$E(PSGWCAT,2)
D CALC^PSGWCAD
AMIS D @($S(PSGWCAT'["R":"SETDSP^PSGWCAD",1:"SETRET^PSGWCAD"))
KILL S $P(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,0),"^",2)=0
K ^PSI(58.5,"AEX",DATDA,SITE,DRGDA)
K PSGWCAT,PSGWQD,LOC3,DOSE,COST,FLD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWCL 2763 printed Apr 09, 2024@20:45:14 Page 2
PSGWCL ;BHAM ISC/PTD,CML-Clear AMIS Exceptions ; 29 Dec 93 / 2:29 PM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
+2 WRITE !!,"This option will show AR/WS drugs for which information is missing.",!,"The information MUST be supplied before the AMIS report can be printed.",!!
+3 ;GET DATES FOR AMIS REPORT
BDT SET %DT="AEX"
SET %DT("A")="BEGINNING date for AMIS report: "
DO ^%DT
KILL %DT
if Y<0
GOTO END
SET BDT=Y
EDT SET %DT="AEX"
SET %DT(0)=BDT
SET %DT("A")="ENDING date for AMIS report: "
DO ^%DT
KILL %DT
if Y<0
GOTO END
SET EDT=Y
+1 IF '$ORDER(^PSI(58.5,"AEX",BDT-1))
WRITE !!,"No AMIS exceptions for selected dates."
GOTO END
+2 SET QUEFLG=0
DO ^PSGWCLP
if QUEFLG
GOTO END
CONT WRITE !!,"Do you wish to edit incomplete data now"
SET %=1
DO YN^DICN
IF %<0!(%=2)
GOTO END
+1 IF '%
WRITE !?5,"Enter ""YES"" or ""NO"""
GOTO CONT
+2 ;LOOP THROUGH THE "AEX" CROSS-REFERENCE
+3 SET DATDA=(BDT-1)
SET (SITE,DRGDA,INC,MSG)=0
DTLP SET DATDA=$ORDER(^PSI(58.5,"AEX",DATDA))
SET PSGWADT=$PIECE(DATDA,".")
if (DATDA>EDT)!(DATDA="")
GOTO MSG
STLP SET SITE=$ORDER(^PSI(58.5,"AEX",DATDA,SITE))
if 'SITE
GOTO DTLP
DRGLP SET DRGDA=$ORDER(^PSI(58.5,"AEX",DATDA,SITE,DRGDA))
if 'DRGDA
GOTO STLP
ASK ;ASK FOR MISSING DRUG DATA
+1 SET PSGWDN=$PIECE(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,0),"^")
SET DRGNAM=$SELECT($PIECE($GET(^PSDRUG(PSGWDN,0)),"^")'="":$PIECE(^(0),"^"),1:"")
IF DRGNAM=""
WRITE !!,"The name for drug ",PSGWDN," is missing from the drug file.",!,"Notify your package coordinator!"
GOTO DRGLP
+2 IF $DATA(LOC(PSGWDN))
DO CHK
GOTO DRGLP
+3 WRITE !!,"==> Information incomplete for: ",DRGNAM,!
+4 SET INC=1
SET DIE="^PSDRUG("
SET DA=PSGWDN
SET DR="13;15;301;302"
DO ^DIE
KILL DIE
if $DATA(Y)
GOTO MSG
SET LOC(PSGWDN)=""
DO CHK
GOTO DRGLP
CHK ;VERIFY THAT USER HAS ENTERED ALL NECESSARY DATA
+1 IF $DATA(^PSDRUG(PSGWDN,660))
SET LOC1=^(660)
SET INC=0
+2 IF '$TEST
SET INC=1
SET MSG=1
QUIT
+3 IF $DATA(^PSDRUG(PSGWDN,"PSG"))
SET LOC2=^("PSG")
SET INC=0
+4 IF '$TEST
SET INC=1
SET MSG=1
QUIT
+5 FOR J=3,5,6
IF $PIECE(LOC1,"^",J)=""
SET INC=1
SET MSG=1
QUIT
+6 FOR J=2,3
IF $PIECE(LOC2,"^",J)=""
SET INC=1
SET MSG=1
QUIT
+7 IF INC=0
DO UPAMIS
+8 QUIT
MSG IF INC!(MSG)
WRITE *7,!!,"DATA IS STILL MISSING! YOU WILL NOT BE ABLE",!,"TO PRINT AMIS UNTIL INFORMATION IS COMPLETE!!"
+1 IF '$TEST
WRITE !!,"DATA COMPLETE!!"
END KILL PSGWCAT,PSGWQD,X,Y,BDT,EDT,SITE,DATDA,DRGDA,DRGNAM,LOC1,LOC2,INC,J,PSGWDN,CAT,COST,DOSE,FLD,FLDA,LOC,LOC3,PSGWADT,PSGWAOU,DA,DR,%,D0,DI,DIG,DIH,DIU,DIV,DQ,DTDA,QUEFLG,G,MSG
QUIT
+1 ;
UPAMIS ;UPDATE THE AMIS SUBFILE AND REMOVE INCOMPLETE FLAG & X-REF
+1 IF '$ORDER(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",0))
DO KILL
QUIT
+2 FOR CAT=0:0
SET CAT=$ORDER(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",CAT))
if 'CAT
QUIT
SET PSGWCAT=$PIECE(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",CAT,0),"^")
SET PSGWQD=$PIECE(^(0),"^",2)
DO UPDATE
+3 QUIT
+4 ;
UPDATE IF PSGWCAT["R"
SET LOC3="^"_$EXTRACT(PSGWCAT,2)
+1 DO CALC^PSGWCAD
AMIS DO @($SELECT(PSGWCAT'["R":"SETDSP^PSGWCAD",1:"SETRET^PSGWCAD"))
KILL SET $PIECE(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,0),"^",2)=0
+1 KILL ^PSI(58.5,"AEX",DATDA,SITE,DRGDA)
+2 KILL PSGWCAT,PSGWQD,LOC3,DOSE,COST,FLD
+3 QUIT
