46 lines
2.7 KiB
Mathematica
46 lines
2.7 KiB
Mathematica
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
|