81 lines
4.9 KiB
Mathematica
81 lines
4.9 KiB
Mathematica
|
PSDPLOG1 ;BIR/JPW,LTL-CS Inspector's Log (cont'd) ; 31 May 95
|
||
|
|
;;3.0; CONTROLLED SUBSTANCES ;**22,28**;13 Feb 97
|
||
|
|
;
|
||
|
|
;References to ^PSD(58.8, covered by DBIA2711
|
||
|
|
;References to ^PSD(58.81 are covered by DBIA2808
|
||
|
|
;References to ^PSDRUG( are covered by DBIA221
|
||
|
|
;References to ^PSI(58.16 are covered by DBIA213
|
||
|
|
;References to ^PSI(58.2( are covered by DBIA213
|
||
|
|
;
|
||
|
|
START ;compile data
|
||
|
|
K ^TMP("PSDLOG",$J) S (PSDCNT,PSDOUT)=0
|
||
|
|
I $D(PSDG) F PSD=0:0 S PSD=$O(PSDG(PSD)) Q:'PSD F PSDN=0:0 S PSDN=$O(^PSI(58.2,PSD,3,PSDN)) Q:'PSDN I $D(^PSD(58.8,PSDN,0)),'$P(^(0),"^",7),$P(^(0),"^",3)=+PSDSITE S NAOU(PSDN)="",CNT=CNT+1
|
||
|
|
I $D(ALL) F PSD=0:0 S PSD=$O(^PSD(58.8,PSD)) Q:'PSD I $D(^PSD(58.8,PSD,0)),$P(^(0),"^",2)="N",$P(^(0),"^",3)=+PSDSITE,'$P(^(0),"^",7) S NAOU(+PSD)=""
|
||
|
|
F STAT=2.99:0 S STAT=$O(^PSD(58.8,"AC",STAT)) Q:('STAT)!(STAT>5) F PSD=0:0 S PSD=$O(^PSD(58.8,"AC",STAT,PSD)) Q:'PSD D LOOP
|
||
|
|
S STAT=10 F PSD=0:0 S PSD=$O(^PSD(58.8,"AC",STAT,PSD)) Q:'PSD D LOOP
|
||
|
|
;PSD*3*28 22JUN00 (DAVE BLOCKER) ;perpetual Inventory
|
||
|
|
S STAT=13 F PSD=0:0 S PSD=$O(^PSD(58.8,"AC",STAT,PSD)) Q:'PSD I $P($G(^PSD(58.8,+PSD,2)),"^",5)'="" D LOOP
|
||
|
|
I $G(PSDRET) F PSDN=PSDSD:0 S PSDN=$O(^PSD(58.81,"ACT",PSDN)) Q:'PSDN!(PSDOUT) F JJ=0:0 S JJ=$O(^PSD(58.81,"ACT",PSDN,JJ)) Q:'JJ!(PSDOUT) D
|
||
|
|
.F PSDR=0:0 S PSDR=$O(^PSD(58.81,"ACT",PSDN,JJ,PSDR)) Q:'PSDR!(PSDOUT) F PSDA=0:0 S PSDA=$O(^PSD(58.81,"ACT",PSDN,JJ,PSDR,3,PSDA)) Q:'PSDA!(PSDOUT) S PSDOK="#" D
|
||
|
|
..Q:'$D(^PSD(58.81,+PSDA,0)) S NODE=^PSD(58.81,PSDA,0),NODE3=$G(^(3))
|
||
|
|
..S PSDRN=$S($P($G(^PSDRUG(+PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ"_PSDR)
|
||
|
|
..S PSD=+$P(NODE,"^",18) Q:'$D(NAOU(PSD))
|
||
|
|
..S PSDNA=$S($P($G(^PSD(58.8,+PSD,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSD)
|
||
|
|
..S NUM=$S($P(NODE,"^",17)]"":$P(NODE,"^",17),1:"UNKNOWN"),QTY=+$P(NODE3,"^",2),EXP=$P(NODE,"^",15),EXPD="" I EXP S Y=EXP X ^DD("DD") S EXPD=Y
|
||
|
|
..S Y=$E(PSDN,1,7) X ^DD("DD") S PSDDT=Y
|
||
|
|
..D SET
|
||
|
|
G:$D(ZTQUEUED) PRTQUE
|
||
|
|
I ASKN G PRINT^PSDPLOG3 Q
|
||
|
|
G PRINT^PSDPLOG2
|
||
|
|
Q
|
||
|
|
PRTQUE ;queues print after compile
|
||
|
|
K ZTSAVE,ZTIO S ZTIO=PSDIO,ZTRTN=$S(ASKN:"PRINT^PSDPLOG3",1:"PRINT^PSDPLOG2"),ZTDESC="Print Narcotic Inspector Log",ZTDTH=$H
|
||
|
|
S (ZTSAVE("^TMP(""PSDLOG"",$J,"),ZTSAVE("CNT"),ZTSAVE("ASK"),ZTSAVE("ASKN"))=""
|
||
|
|
D ^%ZTLOAD K ^TMP("PSDLOG",$J),ZTSK
|
||
|
|
END K %,%DT,%H,%I,%ZIS,ALL,ASK,ASKN,CNT,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,EXP,EXPD,JJ,NAOU,NODE,NODE3,NUM
|
||
|
|
K OK,PSD,PSDA,PSDCNT,PSDDT,PSDG,PSDIO,PSDOK,PSDOUT,PSDN,PSDNA,PSDPT,PSDR,PSDRN,PSDRD,PSDRDT,PSDRET,PSDSD,PSDST,PSDT,PSDTR
|
||
|
|
K QTY,SEL,STAT,STATN,TYP,TYPN,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
||
|
|
K ^TMP("PSDLOG",$J) D ^%ZISC
|
||
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
||
|
|
Q
|
||
|
|
LOOP ;starts drug loop
|
||
|
|
F PSDR=0:0 S PSDR=$O(^PSD(58.8,"AC",STAT,PSD,PSDR)) Q:'PSDR D
|
||
|
|
.F PSDA=0:0 S PSDA=$O(^PSD(58.8,"AC",STAT,PSD,PSDR,PSDA)) Q:'PSDA I $D(^PSD(58.8,PSD,1,PSDR,3,PSDA,0)) S NODE=^PSD(58.8,PSD,1,PSDR,3,PSDA,0) D
|
||
|
|
..;DAVE B (PSD*3*22) Check for matching ORDER STATUSs
|
||
|
|
..;First check 58.8's order node for status inconsistency
|
||
|
|
..S STAT1=$P(NODE,"^",11),STAT2=$P(NODE,"^",12)
|
||
|
|
..I ($G(STAT1)=6)!($G(STAT1)=7)!($G(STAT1)=8)!($G(STAT1)=9)!($G(STAT1)=11)!($G(STAT1)=12) Q
|
||
|
|
..I $G(STAT2)>0 Q
|
||
|
|
..;Then check the transaction file for matching status.
|
||
|
|
..Q:'$D(NAOU(PSD)) S PSDNA=$S($P($G(^PSD(58.8,+PSD,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSD)
|
||
|
|
..S PSDOK=$S(STAT=3:"**",STAT=10:"*",1:""),PSDTR=$P(NODE,"^",17) I STAT=10 Q:$D(^PSD(58.81,"AE",PSDTR))
|
||
|
|
..S PSDRN=$S($P($G(^PSDRUG(PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDR),STAT1=+$P(NODE,"^",11),STATN=$S($P($G(^PSD(58.82,STAT1,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
||
|
|
..S QTY=$P(NODE,"^",19),NUM=$S($P(NODE,"^",16)]"":$P(NODE,"^",16),1:"UNKNOWN"),EXP=$P(NODE,"^",10),EXPD="" I EXP S Y=EXP X ^DD("DD") S EXPD=Y
|
||
|
|
..S PSDST=$P(NODE,"^",14),PSDDT="" I PSDST S Y=$E(PSDST,1,7) X ^DD("DD") S PSDDT=Y
|
||
|
|
..D SET
|
||
|
|
Q
|
||
|
|
SET ;sets ^tmp
|
||
|
|
S PSDCNT=PSDCNT+1
|
||
|
|
I ASKN D LOOP0 Q
|
||
|
|
S:ASK="D" ^TMP("PSDLOG",$J,PSDNA,PSDRN,NUM,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK
|
||
|
|
S:ASK="N" ^TMP("PSDLOG",$J,PSDNA,NUM,PSDRN,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK
|
||
|
|
Q
|
||
|
|
LOOP0 ;sets sort for inventory type sort
|
||
|
|
I '$O(^PSD(58.8,PSD,1,PSDR,2,0)) S TYPN="ZZ** NO INVENTORY TYPE DATA **" D LOOP1 Q
|
||
|
|
;F NAOU=0:0 S NAOU=$O(NAOU(NAOU)) Q:'NAOU
|
||
|
|
F TYP=0:0 S TYP=$O(^PSD(58.8,+PSD,1,PSDR,2,TYP)) Q:'TYP S TYPN=$S($P($G(^PSI(58.16,+TYP,0)),"^")]"":$P(^(0),"^"),1:"TYPE NAME MISSING") D LOOP1
|
||
|
|
Q
|
||
|
|
LOOP1 ;S:ASK="D" ^TMP("PSDLOG",$J,PSDNA,TYPN,PSDRN,NUM,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK
|
||
|
|
S:'$G(TYP) TYP=999999
|
||
|
|
D:ASK="D"
|
||
|
|
.S ^TMP("PSDLOG",$J,"B",PSDNA,PSD)="",^TMP("PSDLOG",$J,PSD,+TYP)=0
|
||
|
|
.S ^TMP("PSDLOG",$J,PSD,"B",TYPN,+TYP)=""
|
||
|
|
.S ^TMP("PSDLOG",$J,PSD,+TYP,PSDR,NUM,PSDCNT)=QTY_U_PSDDT_U_EXPD_U_PSDOK
|
||
|
|
.S ^TMP("PSDLOG",$J,PSD,+TYP,"B",PSDRN,PSDR)=""
|
||
|
|
;S:ASK="N" ^TMP("PSDLOG",$J,PSDNA,TYPN,NUM,PSDRN,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK
|
||
|
|
D:ASK="N"
|
||
|
|
.S ^TMP("PSDLOG",$J,"B",PSDNA,PSD)="",^TMP("PSDLOG",$J,PSD,+TYP)=0
|
||
|
|
.S ^TMP("PSDLOG",$J,PSD,"B",TYPN,+TYP)=""
|
||
|
|
.S ^TMP("PSDLOG",$J,PSD,+TYP,NUM,PSDR,PSDCNT)=QTY_U_PSDDT_U_EXPD_U_PSDOK_U_PSDRN
|
||
|
|
Q
|