- 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
- 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
