- PSDGSL1 ;BIR/JPW-Review Green Sheet Log (cont'd) ; 2 Aug 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- START ;entry for compile
- K ^TMP("PSDGSL",$J)
- D:ASK="N" GS
- D:ASK="D" DATE
- PRINT ;prt data
- K LN S (PSDOUT,PG)=0,$P(LN,"-",132)="" D HDR Q:PSDOUT
- I '$D(^TMP("PSDGSL",$J)) W !!,?15,"*** NO GREEN SHEET DATA ***",!! G DONE
- S PSD="" F S PSD=$O(^TMP("PSDGSL",$J,PSD)) Q:PSD=""!(PSDOUT) S PSDT="" F S PSDT=$O(^TMP("PSDGSL",$J,PSD,PSDT)) Q:PSDT=""!(PSDOUT) F PSDJ=0:0 S PSDJ=$O(^TMP("PSDGSL",$J,PSD,PSDT,PSDJ)) Q:'PSDJ!(PSDOUT) D
- .Q:PSDOUT
- .S NODE=^TMP("PSDGSL",$J,PSD,PSDT,PSDJ),STATN=$P(NODE,"^"),CSTATN=$P(NODE,"^",2),PSDRN=$P(NODE,"^",3),NAOUN=$P(NODE,"^",4)
- .D:$Y+4>IOSL HDR Q:PSDOUT
- .W !,PSD,?12,PSDRN,?45,PSDT,?78,NAOUN,?90,$E(STATN,1,38),!,?90,$E(CSTATN,1,38),!
- DONE I $E(IOST)'="C" W @IOF
- I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu" D ^DIR K DIR
- END K %,%DT,%H,%I,%ZIS,ASK,CSTAT,CSTATN,DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LN,LOC,NAOU,NAOUN,NODE,OK
- K PG,POP,PSD,PSD1,PSD2,PSDATE,PSDED,PSDEV,PSDJ,PSDL,PSDOUT,PSDPN,PSDR,PSDRN,PSDS,PSDSD,PSDSN,PSDT,STAT,STATN,TYPE,X,Y
- K ^TMP("PSDGSL",$J)
- K ZTDESC,ZTRTN,ZTSAVE,ZTSK D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- GS ;green sheet num sort
- S PSD=PSD1-.9999 F S PSD=$O(^PSD(58.81,"D",PSD)) Q:PSD=""!(PSD>PSD2) F PSDJ=0:0 S PSDJ=$O(^PSD(58.81,"D",PSD,PSDJ)) Q:'PSDJ D SET
- Q
- DATE ;date sort
- F PSD=PSDSD:0 S PSD=$O(^PSD(58.81,"AF",PSD)) Q:'PSD!(PSD>PSDED) F PSDL=1.99:0 S PSDL=$O(^PSD(58.81,"AF",PSD,+PSDS,PSDL)) Q:'PSDL!(PSDL>5) F PSDJ=0:0 S PSDJ=$O(^PSD(58.81,"AF",PSD,+PSDS,PSDL,PSDJ)) Q:'PSDJ D SET
- ;F PSD=PSDSD:0 S PSD=$O(^PSD(58.81,"AF",PSD)) Q:'PSD!(PSD>PSDED) F PSDL=2,5 S PSDL=$O(^PSD(58.81,"AF",PSD,PSDS,PSDL)) W !,PSD," ",PSDS," ",PSDL
- Q
- SET ;set data
- Q:'$D(^PSD(58.81,PSDJ,0)) S NODE=^PSD(58.81,PSDJ,0)
- S LOC=+$P(NODE,"^",3) Q:LOC'=+PSDS S TYPE=+$P(NODE,"^",2) S OK=$S(TYPE=2:1,TYPE=5:1,1:0) Q:'OK
- S PSDPN=$P(NODE,"^",17) Q:PSDPN']""
- S (PSDT,Y)=+$E($P(NODE,"^",4),1,12) X ^DD("DD") S PSDT=Y
- S STAT=+$P(NODE,"^",11),STATN=$P($G(^PSD(58.82,STAT,0)),"^")
- Q:STAT=10
- S CSTAT=+$P(NODE,"^",12),CSTATN=$P($G(^PSD(58.83,CSTAT,0)),"^"),NAOU=+$P(NODE,"^",18),NAOUN=$P($G(^PSD(58.8,+NAOU,0)),"^")
- S PSDR=+$P(NODE,"^",5),PSDRN=$P($G(^PSDRUG(PSDR,0)),"^")
- S ^TMP("PSDGSL",$J,PSDPN,PSDT,PSDJ)=STATN_"^"_CSTATN_"^"_PSDRN_"^"_$E(NAOUN,1,10)
- Q
- HDR ;header
- I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
- S PG=PG+1
- W:$Y @IOF W !,?20,"CS GREEN SHEET LISTING REPORT",?70,"PAGE: ",PG
- W:ASK="D" !,?20,$P(PSDATE,"^")," to ",$P(PSDATE,"^",2)
- W:ASK="N" !,?20,"GS # ",$G(PSD1)," through ",$G(PSD2)
- W !,?20,"Dispensing Site: ",PSDSN,!
- W !,"GS #",?12,"DRUG",?45,"DATE DISP",?78,"NAOU",?90,"STATUS",!,LN,!
- Q
- PSDGSL1 ;BIR/JPW-Review Green Sheet Log (cont'd) ; 2 Aug 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- START ;entry for compile
- +1 KILL ^TMP("PSDGSL",$JOB)
- +2 IF ASK="N"
- DO GS
- +3 IF ASK="D"
- DO DATE
- PRINT ;prt data
- +1 KILL LN
- SET (PSDOUT,PG)=0
- SET $PIECE(LN,"-",132)=""
- DO HDR
- IF PSDOUT
- QUIT
- +2 IF '$DATA(^TMP("PSDGSL",$JOB))
- WRITE !!,?15,"*** NO GREEN SHEET DATA ***",!!
- GOTO DONE
- +3 SET PSD=""
- FOR
- SET PSD=$ORDER(^TMP("PSDGSL",$JOB,PSD))
- IF PSD=""!(PSDOUT)
- QUIT
- SET PSDT=""
- FOR
- SET PSDT=$ORDER(^TMP("PSDGSL",$JOB,PSD,PSDT))
- IF PSDT=""!(PSDOUT)
- QUIT
- FOR PSDJ=0:0
- SET PSDJ=$ORDER(^TMP("PSDGSL",$JOB,PSD,PSDT,PSDJ))
- IF 'PSDJ!(PSDOUT)
- QUIT
- Begin DoDot:1
- +4 IF PSDOUT
- QUIT
- +5 SET NODE=^TMP("PSDGSL",$JOB,PSD,PSDT,PSDJ)
- SET STATN=$PIECE(NODE,"^")
- SET CSTATN=$PIECE(NODE,"^",2)
- SET PSDRN=$PIECE(NODE,"^",3)
- SET NAOUN=$PIECE(NODE,"^",4)
- +6 IF $Y+4>IOSL
- DO HDR
- IF PSDOUT
- QUIT
- +7 WRITE !,PSD,?12,PSDRN,?45,PSDT,?78,NAOUN,?90,$EXTRACT(STATN,1,38),!,?90,$EXTRACT(CSTATN,1,38),!
- End DoDot:1
- DONE IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF 'PSDOUT
- WRITE !
- KILL DIR,DIRUT
- SET DIR(0)="EA"
- SET DIR("A")="END OF REPORT! Press <RET> to return to the menu"
- DO ^DIR
- KILL DIR
- END KILL %,%DT,%H,%I,%ZIS,ASK,CSTAT,CSTATN,DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LN,LOC,NAOU,NAOUN,NODE,OK
- +1 KILL PG,POP,PSD,PSD1,PSD2,PSDATE,PSDED,PSDEV,PSDJ,PSDL,PSDOUT,PSDPN,PSDR,PSDRN,PSDS,PSDSD,PSDSN,PSDT,STAT,STATN,TYPE,X,Y
- +2 KILL ^TMP("PSDGSL",$JOB)
- +3 KILL ZTDESC,ZTRTN,ZTSAVE,ZTSK
- DO ^%ZISC
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +4 QUIT
- GS ;green sheet num sort
- +1 SET PSD=PSD1-.9999
- FOR
- SET PSD=$ORDER(^PSD(58.81,"D",PSD))
- IF PSD=""!(PSD>PSD2)
- QUIT
- FOR PSDJ=0:0
- SET PSDJ=$ORDER(^PSD(58.81,"D",PSD,PSDJ))
- IF 'PSDJ
- QUIT
- DO SET
- +2 QUIT
- DATE ;date sort
- +1 FOR PSD=PSDSD:0
- SET PSD=$ORDER(^PSD(58.81,"AF",PSD))
- IF 'PSD!(PSD>PSDED)
- QUIT
- FOR PSDL=1.99:0
- SET PSDL=$ORDER(^PSD(58.81,"AF",PSD,+PSDS,PSDL))
- IF 'PSDL!(PSDL>5)
- QUIT
- FOR PSDJ=0:0
- SET PSDJ=$ORDER(^PSD(58.81,"AF",PSD,+PSDS,PSDL,PSDJ))
- IF 'PSDJ
- QUIT
- DO SET
- +2 ;F PSD=PSDSD:0 S PSD=$O(^PSD(58.81,"AF",PSD)) Q:'PSD!(PSD>PSDED) F PSDL=2,5 S PSDL=$O(^PSD(58.81,"AF",PSD,PSDS,PSDL)) W !,PSD," ",PSDS," ",PSDL
- +3 QUIT
- SET ;set data
- +1 IF '$DATA(^PSD(58.81,PSDJ,0))
- QUIT
- SET NODE=^PSD(58.81,PSDJ,0)
- +2 SET LOC=+$PIECE(NODE,"^",3)
- IF LOC'=+PSDS
- QUIT
- SET TYPE=+$PIECE(NODE,"^",2)
- SET OK=$SELECT(TYPE=2:1,TYPE=5:1,1:0)
- IF 'OK
- QUIT
- +3 SET PSDPN=$PIECE(NODE,"^",17)
- IF PSDPN']""
- QUIT
- +4 SET (PSDT,Y)=+$EXTRACT($PIECE(NODE,"^",4),1,12)
- XECUTE ^DD("DD")
- SET PSDT=Y
- +5 SET STAT=+$PIECE(NODE,"^",11)
- SET STATN=$PIECE($GET(^PSD(58.82,STAT,0)),"^")
- +6 IF STAT=10
- QUIT
- +7 SET CSTAT=+$PIECE(NODE,"^",12)
- SET CSTATN=$PIECE($GET(^PSD(58.83,CSTAT,0)),"^")
- SET NAOU=+$PIECE(NODE,"^",18)
- SET NAOUN=$PIECE($GET(^PSD(58.8,+NAOU,0)),"^")
- +8 SET PSDR=+$PIECE(NODE,"^",5)
- SET PSDRN=$PIECE($GET(^PSDRUG(PSDR,0)),"^")
- +9 SET ^TMP("PSDGSL",$JOB,PSDPN,PSDT,PSDJ)=STATN_"^"_CSTATN_"^"_PSDRN_"^"_$EXTRACT(NAOUN,1,10)
- +10 QUIT
- HDR ;header
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF PG
- WRITE !
- KILL DA,DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSDOUT=1
- QUIT
- +2 SET PG=PG+1
- +3 IF $Y
- WRITE @IOF
- WRITE !,?20,"CS GREEN SHEET LISTING REPORT",?70,"PAGE: ",PG
- +4 IF ASK="D"
- WRITE !,?20,$PIECE(PSDATE,"^")," to ",$PIECE(PSDATE,"^",2)
- +5 IF ASK="N"
- WRITE !,?20,"GS # ",$GET(PSD1)," through ",$GET(PSD2)
- +6 WRITE !,?20,"Dispensing Site: ",PSDSN,!
- +7 WRITE !,"GS #",?12,"DRUG",?45,"DATE DISP",?78,"NAOU",?90,"STATUS",!,LN,!
- +8 QUIT
