source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWCL.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1PSGWCL ;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
5BDT S %DT="AEX",%DT("A")="BEGINNING date for AMIS report: " D ^%DT K %DT G:Y<0 END S BDT=Y
6EDT 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
9CONT 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
13DTLP S DATDA=$O(^PSI(58.5,"AEX",DATDA)),PSGWADT=$P(DATDA,".") G:(DATDA>EDT)!(DATDA="") MSG
14STLP S SITE=$O(^PSI(58.5,"AEX",DATDA,SITE)) G:'SITE DTLP
15DRGLP S DRGDA=$O(^PSI(58.5,"AEX",DATDA,SITE,DRGDA)) G:'DRGDA STLP
16ASK ;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
21CHK ;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
30MSG 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!!"
32END 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 ;
34UPAMIS ;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 ;
39UPDATE I PSGWCAT["R" S LOC3="^"_$E(PSGWCAT,2)
40 D CALC^PSGWCAD
41AMIS D @($S(PSGWCAT'["R":"SETDSP^PSGWCAD",1:"SETRET^PSGWCAD"))
42KILL 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
Note: See TracBrowser for help on using the repository browser.