43 lines
3.2 KiB
Mathematica
43 lines
3.2 KiB
Mathematica
|
PSGWUAS ;BHAM ISC/PTD,CML-Update AMIS Stats File ; 08 Dec 93 / 9:00 AM
|
||
|
|
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
||
|
|
;CHECK FOR NON-PHARMACY ITEMS IN AOUs
|
||
|
|
D ^PSGWCAD3
|
||
|
|
;ROUTINE LOOPS THROUGH ^PSI(58.5,"AMIS" CROSS REFERENCE, CALCULATES AND STORES AMIS DATA IN ^PSI(58.5,.
|
||
|
|
D:$O(^PSI(58.5,"AMISERR",0)) ERRCHK S CURDT=0
|
||
|
|
;CALL TO DRUG ACCOUNTABILITY TO RECORD DISPENSING
|
||
|
|
I $P($G(^PS(59.7,+$O(^PS(59.7,0)),70)),U,5),$D(^%ZOSF("TEST")) S X="PSARWS" X ^%ZOSF("TEST") K X I D ^PSARWS
|
||
|
|
L +^PSI(58.5,"AMIS")
|
||
|
|
DTLP S CURDT=$O(^PSI(58.5,"AMIS",CURDT)) G:CURDT="" END S ADT=0
|
||
|
|
ADT S ADT=$O(^PSI(58.5,"AMIS",CURDT,ADT)) G:'ADT DTLP S PSGWADT=$P(ADT,"."),PSGWCAT=0
|
||
|
|
CAT S PSGWCAT=$O(^PSI(58.5,"AMIS",CURDT,ADT,PSGWCAT)) G:PSGWCAT="" ADT S PSGWAOU=0
|
||
|
|
AOU S PSGWAOU=$O(^PSI(58.5,"AMIS",CURDT,ADT,PSGWCAT,PSGWAOU)) G:'PSGWAOU CAT S PSGWDN=0 S AOU=PSGWAOU D AOUCHK
|
||
|
|
DRLP S PSGWDN=$O(^PSI(58.5,"AMIS",CURDT,ADT,PSGWCAT,PSGWAOU,PSGWDN)) G:'PSGWDN AOU S PSGWQD=""
|
||
|
|
QDLP S PSGWQD=$O(^PSI(58.5,"AMIS",CURDT,ADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD)) G:'PSGWQD DRLP
|
||
|
|
I ERR S ^PSI(58.5,"AMISERR",PSGWAOU,CURDT,ADT,PSGWCAT,PSGWDN,PSGWQD)="" K ^PSI(58.5,"AMIS",CURDT,ADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD) G QDLP
|
||
|
|
D ^PSGWCAD D @$S(PSGWCAT="A":"INV",PSGWCAT="R":"RET",1:"OND") K ^PSI(58.5,"AMIS",CURDT,ADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD) G QDLP
|
||
|
|
END D:$O(ERR1(0)) MAIL^PSGWCAD1 D:$O(ERR2(0)) MAIL^PSGWCAD2
|
||
|
|
D NOW^%DTC S PSGWUPDT=%,DIE="^PS(59.7,",DA=1,DR="50///"_PSGWUPDT D ^DIE K DIE
|
||
|
|
K CURDT,PSGWADT,PSGWCAT,PSGWAOU,PSGWDN,PSGWQD,ADT,DRGDA,INVDA,VAR,CMPDT,PSGWUPDT,%,%I,%H,%Z,D0,DI,DA,DR,DIE,DQ,AOU,ERR,ERR1,ERR2,GOTIT,SITE,X,Y L -^PSI(58.5,"AMIS") Q
|
||
|
|
AOUCHK ; Check AOU for SITE - ERR=1 => Missing Inp. Site ERR=2 => Invalid Inp. Site
|
||
|
|
S ERR=0 I $D(^PSI(58.1,AOU,"SITE")),^("SITE") S SITE=^("SITE") I $D(^PS(59.4,SITE,0)),$P(^(0),"^",26) Q
|
||
|
|
S ERR=$S('$D(^PSI(58.1,AOU,"SITE")):1,'^("SITE"):1,1:2) S:ERR=1 ERR1(AOU)="" Q:ERR=1 S ERR2(AOU)="" Q
|
||
|
|
;
|
||
|
|
INV ;SET THE COMPILE FLAG FOR SUBFILE 58.12 - INVENTORY
|
||
|
|
Q:'$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDN,0)) S DRGDA=$O(^(0)) Q:'$O(^PSI(58.19,"B",ADT,0)) S INVDA=$O(^(0)),$P(^PSI(58.1,PSGWAOU,1,DRGDA,1,INVDA,0),"^",4)=1 Q
|
||
|
|
;
|
||
|
|
RET ;SET THE COMPILE FLAG FOR SUBFILE 58.15 - RETURNS
|
||
|
|
Q:'$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDN,0)) S DRGDA=$O(^(0)),$P(^PSI(58.1,PSGWAOU,1,DRGDA,3,PSGWADT,0),"^",4)=1 Q
|
||
|
|
;
|
||
|
|
OND ;SET THE COMPILE FLAG FOR SUBFILE 58.28 - ON-DEMANDS
|
||
|
|
Q:'$O(^PSI(58.1,PSGWAOU,1,"B",PSGWDN,0)) S DRGDA=$O(^(0)) F VAR=0:0 S VAR=$O(^PSI(58.1,PSGWAOU,1,DRGDA,5,VAR)) Q:'VAR S CMPDT=$P(^(VAR,0),"^") Q:CMPDT=PSGWADT I VAR'="" S $P(^PSI(58.1,PSGWAOU,1,DRGDA,5,VAR,0),"^",4)=1
|
||
|
|
Q
|
||
|
|
ERRCHK ;Check "ERR" nodes for Site Data for AOUs
|
||
|
|
Q:'$O(^PSI(58.5,"AMISERR",0)) F AOU=0:0 S AOU=$O(^PSI(58.5,"AMISERR",AOU)) Q:'AOU D AOUCHK I 'ERR D SET1
|
||
|
|
K AOU,HH,ADT,CAT,DRG,QD,LL,SITE Q
|
||
|
|
SET1 ;
|
||
|
|
S HH="" F LL=0:0 S HH=$O(^PSI(58.5,"AMISERR",AOU,HH)) Q:HH="" F ADT=0:0 S ADT=$O(^PSI(58.5,"AMISERR",AOU,HH,ADT)) Q:'ADT S CAT="" F LL=0:0 S CAT=$O(^PSI(58.5,"AMISERR",AOU,HH,ADT,CAT)) Q:CAT="" D SET2
|
||
|
|
Q
|
||
|
|
SET2 ;
|
||
|
|
F DRG=0:0 S DRG=$O(^PSI(58.5,"AMISERR",AOU,HH,ADT,CAT,DRG)) Q:'DRG F QD=-100000:0 S QD=$O(^PSI(58.5,"AMISERR",AOU,HH,ADT,CAT,DRG,QD)) Q:'QD S ^PSI(58.5,"AMIS",HH,ADT,CAT,AOU,DRG,QD)="" K ^PSI(58.5,"AMISERR",AOU,HH,ADT,CAT,DRG,QD)
|
||
|
|
Q
|