source: FOIAVistA/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDRLOG1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.0 KB
Line 
1PSDRLOG1 ;BIR/JPW-CS Inspector's Log By Date (cont'd) ; 24 Aug 94
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3START ;compile data
4 K ^TMP("PSDRLOG",$J) S (FLAG,PSDCNT,PSDOUT)=0,PSDTR=""
5 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
6 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)=""
7 S PSD="" F S PSD=$O(NAOU(PSD)) Q:PSD=""!(PSDOUT) F PSDN=PSDSD:0 S PSDN=$O(^PSD(58.81,"AK",PSDN)) Q:'PSDN!(PSDOUT) F PSDA=0:0 S PSDA=$O(^PSD(58.81,"AK",PSDN,PSD,PSDA)) Q:'PSDA!(PSDOUT) D LOOP
8 I $G(PSDRET) F PSDN=PSDRD: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
9 .F KK=0:0 S KK=$O(^PSD(58.81,"ACT",PSDN,JJ,KK)) Q:'KK!(PSDOUT) F PSDA=0:0 S PSDA=$O(^PSD(58.81,"ACT",PSDN,JJ,KK,3,PSDA)) Q:'PSDA!(PSDOUT) S FLAG=3 D LOOP
10 F PSDN=PSDSD:0 S PSDN=$O(^PSD(58.81,"ATRN",PSDN)) Q:'PSDN!(PSDOUT) F PSDA=0:0 S PSDA=$O(^PSD(58.81,"ATRN",PSDN,PSDA)) Q:'PSDA!(PSDOUT) S FLAG=1 D LOOP
11 G:$D(ZTQUEUED) PRTQUE
12 I ASKN G PRINT^PSDRLOG3
13 G PRINT^PSDRLOG2
14 Q
15PRTQUE ;queues print after compile
16 K ZTSAVE,ZTIO S ZTIO=PSDIO,ZTRTN=$S(ASKN:"PRINT^PSDRLOG3",1:"PRINT^PSDRLOG2"),ZTDESC="Print Narcotic Inspector Log",ZTDTH=$H
17 S (ZTSAVE("^TMP(""PSDRLOG"",$J,"),ZTSAVE("CNT"),ZTSAVE("ASK"),ZTSAVE("ASKN"),ZTSAVE("PSDRET"))=""
18 D ^%ZTLOAD K ^TMP("PSDRLOG",$J),ZTSK
19END K %,%H,%I,%ZIS,ALL,ASK,ASKN,CNT,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,EXP,EXPD,FLAG,JJ,KK,LNUM,NAOU,NODE,NODE1,NODE3,NODE7,NUM
20 K OK,PSD,PSDA,PSDATE,PSDCNT,PSDDT,PSDG,PSDIO,PSDOK,PSDOUT,PSDN,PSDNA,PSDR,PSDRD,PSDRET,PSDRN,PSDSD,PSDST,PSDTR,PSDTYP
21 K QTY,SEL,STAT,TYP,TYPN,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
22 K ^TMP("PSDRLOG",$J) D ^%ZISC
23 S:$D(ZTQUEUED) ZTREQ="@"
24 Q
25LOOP ;starts drug loop
26 Q:'$D(^PSD(58.81,+PSDA,0)) S NODE=^PSD(58.81,PSDA,0)
27 S PSDR=+$P(NODE,"^",5),STAT=+$P(NODE,"^",11),PSDTYP=+$P(NODE,"^",2)
28 S NODE1=$G(^PSD(58.81,PSDA,1)),NODE7=$G(^PSD(58.81,PSDA,7)),NODE3=$G(^PSD(58.81,PSDA,3))
29 S:PSDTYP=5 FLAG=2
30 I FLAG S PSD=+$P(NODE,"^",18) Q:'$D(NAOU(+PSD))
31 S:FLAG=1 PSDTR=+$P(NODE7,"^",3),PSDTR=$S($P($G(^PSD(58.8,PSDTR,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
32 S PSDNA=$S($P($G(^PSD(58.8,+PSD,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSD)
33 S PSDOK=$S(FLAG=3:"#",FLAG=2:"**",FLAG=1:"*",1:"")
34 S PSDRN=$S($P($G(^PSDRUG(PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDR)
35 S QTY=$S(FLAG=3:+$P(NODE3,"^",2),FLAG=1:+$P(NODE7,"^",7),1:+$P(NODE1,"^",8))
36 S NUM=$S($P(NODE,"^",17)]"":$P(NODE,"^",17),1:"UNKNOWN"),EXP=$P(NODE,"^",15),EXPD="" I EXP S Y=EXP X ^DD("DD") S EXPD=Y
37 S Y=$E(PSDN,1,7) X ^DD("DD") S PSDDT=Y
38 S PSDCNT=PSDCNT+1,FLAG=0
39 I ASKN D LOOP0 Q
40SET ;sets ^tmp
41 S:ASK="D" ^TMP("PSDRLOG",$J,PSDNA,PSDRN,NUM,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
42 S:ASK="N" ^TMP("PSDRLOG",$J,PSDNA,NUM,PSDRN,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
43 Q
44LOOP0 ;sets sort for inventory type sort
45 I '$O(^PSD(58.8,PSD,1,PSDR,2,0)) S TYPN="ZZ** NO INVENTORY TYPE DATA **" D LOOP1 Q
46 ;F NAOU=0:0 S NAOU=$O(NAOU(NAOU)) Q:'NAOU
47 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
48 Q
49LOOP1 ;sets inv typ ^tmp
50 ;S:ASK="D" ^TMP("PSDRLOG",$J,PSDNA,TYPN,PSDRN,NUM,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
51 S:'$G(TYP) TYP=999999
52 D:ASK="D"
53 .S ^TMP("PSDRLOG",$J,"B",PSDNA,PSD)="",^TMP("PSDLOG",$J,PSD,+TYP)=0
54 .S ^TMP("PSDRLOG",$J,PSD,"B",TYPN,+TYP)=""
55 .S ^TMP("PSDRLOG",$J,PSD,+TYP,PSDR,NUM,PSDCNT)=QTY_U_PSDDT_U_EXPD_U_PSDOK
56 .S ^TMP("PSDRLOG",$J,PSD,+TYP,"B",PSDRN,PSDR)=""
57 ;S:ASK="N" ^TMP("PSDRLOG",$J,PSDNA,TYPN,NUM,PSDRN,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
58 D:ASK="N"
59 .S ^TMP("PSDRLOG",$J,"B",PSDNA,PSD)="",^TMP("PSDRLOG",$J,PSD,+TYP)=0
60 .S ^TMP("PSDRLOG",$J,PSD,"B",TYPN,+TYP)=""
61 .S ^TMP("PSDRLOG",$J,PSD,+TYP,NUM,PSDR,PSDCNT)=QTY_U_PSDDT_U_EXPD_U_PSDOK_U_PSDTR_U_PSDRN
62 Q
Note: See TracBrowser for help on using the repository browser.