| [613] | 1 | PSGWCL ;BHAM ISC/PTD,CML-Clear AMIS Exceptions ; 29 Dec 93 / 2:29 PM
|
|---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|---|
| 3 | 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.",!!
|
|---|
| 4 | ;GET DATES FOR AMIS REPORT
|
|---|
| 5 | BDT S %DT="AEX",%DT("A")="BEGINNING date for AMIS report: " D ^%DT K %DT G:Y<0 END S BDT=Y
|
|---|
| 6 | 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
|
|---|
| 7 | I '$O(^PSI(58.5,"AEX",BDT-1)) W !!,"No AMIS exceptions for selected dates." G END
|
|---|
| 8 | S QUEFLG=0 D ^PSGWCLP G:QUEFLG END
|
|---|
| 9 | CONT W !!,"Do you wish to edit incomplete data now" S %=1 D YN^DICN I %<0!(%=2) G END
|
|---|
| 10 | I '% W !?5,"Enter ""YES"" or ""NO""" G CONT
|
|---|
| 11 | ;LOOP THROUGH THE "AEX" CROSS-REFERENCE
|
|---|
| 12 | S DATDA=(BDT-1),(SITE,DRGDA,INC,MSG)=0
|
|---|
| 13 | DTLP S DATDA=$O(^PSI(58.5,"AEX",DATDA)),PSGWADT=$P(DATDA,".") G:(DATDA>EDT)!(DATDA="") MSG
|
|---|
| 14 | STLP S SITE=$O(^PSI(58.5,"AEX",DATDA,SITE)) G:'SITE DTLP
|
|---|
| 15 | DRGLP S DRGDA=$O(^PSI(58.5,"AEX",DATDA,SITE,DRGDA)) G:'DRGDA STLP
|
|---|
| 16 | ASK ;ASK FOR MISSING DRUG DATA
|
|---|
| 17 | 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
|
|---|
| 18 | I $D(LOC(PSGWDN)) D CHK G DRGLP
|
|---|
| 19 | W !!,"==> Information incomplete for: ",DRGNAM,!
|
|---|
| 20 | 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
|
|---|
| 21 | CHK ;VERIFY THAT USER HAS ENTERED ALL NECESSARY DATA
|
|---|
| 22 | I $D(^PSDRUG(PSGWDN,660)) S LOC1=^(660),INC=0
|
|---|
| 23 | E S INC=1,MSG=1 Q
|
|---|
| 24 | I $D(^PSDRUG(PSGWDN,"PSG")) S LOC2=^("PSG"),INC=0
|
|---|
| 25 | E S INC=1,MSG=1 Q
|
|---|
| 26 | F J=3,5,6 I $P(LOC1,"^",J)="" S INC=1,MSG=1 Q
|
|---|
| 27 | F J=2,3 I $P(LOC2,"^",J)="" S INC=1,MSG=1 Q
|
|---|
| 28 | I INC=0 D UPAMIS
|
|---|
| 29 | Q
|
|---|
| 30 | MSG I INC!(MSG) W *7,!!,"DATA IS STILL MISSING! YOU WILL NOT BE ABLE",!,"TO PRINT AMIS UNTIL INFORMATION IS COMPLETE!!"
|
|---|
| 31 | E W !!,"DATA COMPLETE!!"
|
|---|
| 32 | 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
|
|---|
| 33 | ;
|
|---|
| 34 | UPAMIS ;UPDATE THE AMIS SUBFILE AND REMOVE INCOMPLETE FLAG & X-REF
|
|---|
| 35 | I '$O(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,"CAT",0)) D KILL Q
|
|---|
| 36 | 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
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | UPDATE I PSGWCAT["R" S LOC3="^"_$E(PSGWCAT,2)
|
|---|
| 40 | D CALC^PSGWCAD
|
|---|
| 41 | AMIS D @($S(PSGWCAT'["R":"SETDSP^PSGWCAD",1:"SETRET^PSGWCAD"))
|
|---|
| 42 | KILL S $P(^PSI(58.5,DATDA,"S",SITE,"DRG",DRGDA,0),"^",2)=0
|
|---|
| 43 | K ^PSI(58.5,"AEX",DATDA,SITE,DRGDA)
|
|---|
| 44 | K PSGWCAT,PSGWQD,LOC3,DOSE,COST,FLD
|
|---|
| 45 | Q
|
|---|
