PSDRLOG1 ;BIR/JPW-CS Inspector's Log By Date (cont'd) ; 24 Aug 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
START ;compile data
K ^TMP("PSDRLOG",$J) S (FLAG,PSDCNT,PSDOUT)=0,PSDTR=""
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)=""
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
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
.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
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
G:$D(ZTQUEUED) PRTQUE
I ASKN G PRINT^PSDRLOG3
G PRINT^PSDRLOG2
Q
PRTQUE ;queues print after compile
K ZTSAVE,ZTIO S ZTIO=PSDIO,ZTRTN=$S(ASKN:"PRINT^PSDRLOG3",1:"PRINT^PSDRLOG2"),ZTDESC="Print Narcotic Inspector Log",ZTDTH=$H
S (ZTSAVE("^TMP(""PSDRLOG"",$J,"),ZTSAVE("CNT"),ZTSAVE("ASK"),ZTSAVE("ASKN"),ZTSAVE("PSDRET"))=""
D ^%ZTLOAD K ^TMP("PSDRLOG",$J),ZTSK
END 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
K OK,PSD,PSDA,PSDATE,PSDCNT,PSDDT,PSDG,PSDIO,PSDOK,PSDOUT,PSDN,PSDNA,PSDR,PSDRD,PSDRET,PSDRN,PSDSD,PSDST,PSDTR,PSDTYP
K QTY,SEL,STAT,TYP,TYPN,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
K ^TMP("PSDRLOG",$J) D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@"
Q
LOOP ;starts drug loop
Q:'$D(^PSD(58.81,+PSDA,0)) S NODE=^PSD(58.81,PSDA,0)
S PSDR=+$P(NODE,"^",5),STAT=+$P(NODE,"^",11),PSDTYP=+$P(NODE,"^",2)
S NODE1=$G(^PSD(58.81,PSDA,1)),NODE7=$G(^PSD(58.81,PSDA,7)),NODE3=$G(^PSD(58.81,PSDA,3))
S:PSDTYP=5 FLAG=2
I FLAG S PSD=+$P(NODE,"^",18) Q:'$D(NAOU(+PSD))
S:FLAG=1 PSDTR=+$P(NODE7,"^",3),PSDTR=$S($P($G(^PSD(58.8,PSDTR,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
S PSDNA=$S($P($G(^PSD(58.8,+PSD,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSD)
S PSDOK=$S(FLAG=3:"#",FLAG=2:"**",FLAG=1:"*",1:"")
S PSDRN=$S($P($G(^PSDRUG(PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDR)
S QTY=$S(FLAG=3:+$P(NODE3,"^",2),FLAG=1:+$P(NODE7,"^",7),1:+$P(NODE1,"^",8))
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
S Y=$E(PSDN,1,7) X ^DD("DD") S PSDDT=Y
S PSDCNT=PSDCNT+1,FLAG=0
I ASKN D LOOP0 Q
SET ;sets ^tmp
S:ASK="D" ^TMP("PSDRLOG",$J,PSDNA,PSDRN,NUM,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
S:ASK="N" ^TMP("PSDRLOG",$J,PSDNA,NUM,PSDRN,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
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 ;sets inv typ ^tmp
;S:ASK="D" ^TMP("PSDRLOG",$J,PSDNA,TYPN,PSDRN,NUM,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
S:'$G(TYP) TYP=999999
D:ASK="D"
.S ^TMP("PSDRLOG",$J,"B",PSDNA,PSD)="",^TMP("PSDLOG",$J,PSD,+TYP)=0
.S ^TMP("PSDRLOG",$J,PSD,"B",TYPN,+TYP)=""
.S ^TMP("PSDRLOG",$J,PSD,+TYP,PSDR,NUM,PSDCNT)=QTY_U_PSDDT_U_EXPD_U_PSDOK
.S ^TMP("PSDRLOG",$J,PSD,+TYP,"B",PSDRN,PSDR)=""
;S:ASK="N" ^TMP("PSDRLOG",$J,PSDNA,TYPN,NUM,PSDRN,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
D:ASK="N"
.S ^TMP("PSDRLOG",$J,"B",PSDNA,PSD)="",^TMP("PSDRLOG",$J,PSD,+TYP)=0
.S ^TMP("PSDRLOG",$J,PSD,"B",TYPN,+TYP)=""
.S ^TMP("PSDRLOG",$J,PSD,+TYP,NUM,PSDR,PSDCNT)=QTY_U_PSDDT_U_EXPD_U_PSDOK_U_PSDTR_U_PSDRN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDRLOG1 4120 printed Sep 23, 2025@19:24:51 Page 2
PSDRLOG1 ;BIR/JPW-CS Inspector's Log By Date (cont'd) ; 24 Aug 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
START ;compile data
+1 KILL ^TMP("PSDRLOG",$JOB)
SET (FLAG,PSDCNT,PSDOUT)=0
SET PSDTR=""
+2 IF $DATA(PSDG)
FOR PSD=0:0
SET PSD=$ORDER(PSDG(PSD))
if 'PSD
QUIT
FOR PSDN=0:0
SET PSDN=$ORDER(^PSI(58.2,PSD,3,PSDN))
if 'PSDN
QUIT
IF $DATA(^PSD(58.8,PSDN,0))
IF '$PIECE(^(0),"^",7)
IF $PIECE(^(0),"^",3)=+PSDSITE
SET NAOU(PSDN)=""
SET CNT=CNT+1
+3 IF $DATA(ALL)
FOR PSD=0:0
SET PSD=$ORDER(^PSD(58.8,PSD))
if 'PSD
QUIT
IF $DATA(^PSD(58.8,PSD,0))
IF $PIECE(^(0),"^",2)="N"
IF $PIECE(^(0),"^",3)=+PSDSITE
IF '$PIECE(^(0),"^",7)
SET NAOU(+PSD)=""
+4 SET PSD=""
FOR
SET PSD=$ORDER(NAOU(PSD))
if PSD=""!(PSDOUT)
QUIT
FOR PSDN=PSDSD:0
SET PSDN=$ORDER(^PSD(58.81,"AK",PSDN))
if 'PSDN!(PSDOUT)
QUIT
FOR PSDA=0:0
SET PSDA=$ORDER(^PSD(58.81,"AK",PSDN,PSD,PSDA))
if 'PSDA!(PSDOUT)
QUIT
DO LOOP
+5 IF $GET(PSDRET)
FOR PSDN=PSDRD:0
SET PSDN=$ORDER(^PSD(58.81,"ACT",PSDN))
if 'PSDN!(PSDOUT)
QUIT
FOR JJ=0:0
SET JJ=$ORDER(^PSD(58.81,"ACT",PSDN,JJ))
if 'JJ!(PSDOUT)
QUIT
Begin DoDot:1
+6 FOR KK=0:0
SET KK=$ORDER(^PSD(58.81,"ACT",PSDN,JJ,KK))
if 'KK!(PSDOUT)
QUIT
FOR PSDA=0:0
SET PSDA=$ORDER(^PSD(58.81,"ACT",PSDN,JJ,KK,3,PSDA))
if 'PSDA!(PSDOUT)
QUIT
SET FLAG=3
DO LOOP
End DoDot:1
+7 FOR PSDN=PSDSD:0
SET PSDN=$ORDER(^PSD(58.81,"ATRN",PSDN))
if 'PSDN!(PSDOUT)
QUIT
FOR PSDA=0:0
SET PSDA=$ORDER(^PSD(58.81,"ATRN",PSDN,PSDA))
if 'PSDA!(PSDOUT)
QUIT
SET FLAG=1
DO LOOP
+8 if $DATA(ZTQUEUED)
GOTO PRTQUE
+9 IF ASKN
GOTO PRINT^PSDRLOG3
+10 GOTO PRINT^PSDRLOG2
+11 QUIT
PRTQUE ;queues print after compile
+1 KILL ZTSAVE,ZTIO
SET ZTIO=PSDIO
SET ZTRTN=$SELECT(ASKN:"PRINT^PSDRLOG3",1:"PRINT^PSDRLOG2")
SET ZTDESC="Print Narcotic Inspector Log"
SET ZTDTH=$HOROLOG
+2 SET (ZTSAVE("^TMP(""PSDRLOG"",$J,"),ZTSAVE("CNT"),ZTSAVE("ASK"),ZTSAVE("ASKN"),ZTSAVE("PSDRET"))=""
+3 DO ^%ZTLOAD
KILL ^TMP("PSDRLOG",$JOB),ZTSK
END KILL %,%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
+1 KILL OK,PSD,PSDA,PSDATE,PSDCNT,PSDDT,PSDG,PSDIO,PSDOK,PSDOUT,PSDN,PSDNA,PSDR,PSDRD,PSDRET,PSDRN,PSDSD,PSDST,PSDTR,PSDTYP
+2 KILL QTY,SEL,STAT,TYP,TYPN,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+3 KILL ^TMP("PSDRLOG",$JOB)
DO ^%ZISC
+4 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
LOOP ;starts drug loop
+1 if '$DATA(^PSD(58.81,+PSDA,0))
QUIT
SET NODE=^PSD(58.81,PSDA,0)
+2 SET PSDR=+$PIECE(NODE,"^",5)
SET STAT=+$PIECE(NODE,"^",11)
SET PSDTYP=+$PIECE(NODE,"^",2)
+3 SET NODE1=$GET(^PSD(58.81,PSDA,1))
SET NODE7=$GET(^PSD(58.81,PSDA,7))
SET NODE3=$GET(^PSD(58.81,PSDA,3))
+4 if PSDTYP=5
SET FLAG=2
+5 IF FLAG
SET PSD=+$PIECE(NODE,"^",18)
if '$DATA(NAOU(+PSD))
QUIT
+6 if FLAG=1
SET PSDTR=+$PIECE(NODE7,"^",3)
SET PSDTR=$SELECT($PIECE($GET(^PSD(58.8,PSDTR,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
+7 SET PSDNA=$SELECT($PIECE($GET(^PSD(58.8,+PSD,0)),"^")]"":$PIECE(^(0),"^"),1:"ZZ/"_PSD)
+8 SET PSDOK=$SELECT(FLAG=3:"#",FLAG=2:"**",FLAG=1:"*",1:"")
+9 SET PSDRN=$SELECT($PIECE($GET(^PSDRUG(PSDR,0)),"^")]"":$PIECE(^(0),"^"),1:"ZZ/"_PSDR)
+10 SET QTY=$SELECT(FLAG=3:+$PIECE(NODE3,"^",2),FLAG=1:+$PIECE(NODE7,"^",7),1:+$PIECE(NODE1,"^",8))
+11 SET NUM=$SELECT($PIECE(NODE,"^",17)]"":$PIECE(NODE,"^",17),1:"UNKNOWN")
SET EXP=$PIECE(NODE,"^",15)
SET EXPD=""
IF EXP
SET Y=EXP
XECUTE ^DD("DD")
SET EXPD=Y
+12 SET Y=$EXTRACT(PSDN,1,7)
XECUTE ^DD("DD")
SET PSDDT=Y
+13 SET PSDCNT=PSDCNT+1
SET FLAG=0
+14 IF ASKN
DO LOOP0
QUIT
SET ;sets ^tmp
+1 if ASK="D"
SET ^TMP("PSDRLOG",$JOB,PSDNA,PSDRN,NUM,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
+2 if ASK="N"
SET ^TMP("PSDRLOG",$JOB,PSDNA,NUM,PSDRN,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
+3 QUIT
LOOP0 ;sets sort for inventory type sort
+1 IF '$ORDER(^PSD(58.8,PSD,1,PSDR,2,0))
SET TYPN="ZZ** NO INVENTORY TYPE DATA **"
DO LOOP1
QUIT
+2 ;F NAOU=0:0 S NAOU=$O(NAOU(NAOU)) Q:'NAOU
+3 FOR TYP=0:0
SET TYP=$ORDER(^PSD(58.8,+PSD,1,PSDR,2,TYP))
if 'TYP
QUIT
SET TYPN=$SELECT($PIECE($GET(^PSI(58.16,+TYP,0)),"^")]"":$PIECE(^(0),"^"),1:"TYPE NAME MISSING")
DO LOOP1
+4 QUIT
LOOP1 ;sets inv typ ^tmp
+1 ;S:ASK="D" ^TMP("PSDRLOG",$J,PSDNA,TYPN,PSDRN,NUM,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
+2 if '$GET(TYP)
SET TYP=999999
+3 if ASK="D"
Begin DoDot:1
+4 SET ^TMP("PSDRLOG",$JOB,"B",PSDNA,PSD)=""
SET ^TMP("PSDLOG",$JOB,PSD,+TYP)=0
+5 SET ^TMP("PSDRLOG",$JOB,PSD,"B",TYPN,+TYP)=""
+6 SET ^TMP("PSDRLOG",$JOB,PSD,+TYP,PSDR,NUM,PSDCNT)=QTY_U_PSDDT_U_EXPD_U_PSDOK
+7 SET ^TMP("PSDRLOG",$JOB,PSD,+TYP,"B",PSDRN,PSDR)=""
End DoDot:1
+8 ;S:ASK="N" ^TMP("PSDRLOG",$J,PSDNA,TYPN,NUM,PSDRN,PSDCNT)=QTY_"^"_PSDDT_"^"_EXPD_"^"_PSDOK_"^"_PSDTR
+9 if ASK="N"
Begin DoDot:1
+10 SET ^TMP("PSDRLOG",$JOB,"B",PSDNA,PSD)=""
SET ^TMP("PSDRLOG",$JOB,PSD,+TYP)=0
+11 SET ^TMP("PSDRLOG",$JOB,PSD,"B",TYPN,+TYP)=""
+12 SET ^TMP("PSDRLOG",$JOB,PSD,+TYP,NUM,PSDR,PSDCNT)=QTY_U_PSDDT_U_EXPD_U_PSDOK_U_PSDTR_U_PSDRN
End DoDot:1
+13 QUIT
