| 1 | PSDGSL1 ;BIR/JPW-Review Green Sheet Log (cont'd) ; 2 Aug 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | START ;entry for compile
|
|---|
| 4 | K ^TMP("PSDGSL",$J)
|
|---|
| 5 | D:ASK="N" GS
|
|---|
| 6 | D:ASK="D" DATE
|
|---|
| 7 | PRINT ;prt data
|
|---|
| 8 | K LN S (PSDOUT,PG)=0,$P(LN,"-",132)="" D HDR Q:PSDOUT
|
|---|
| 9 | I '$D(^TMP("PSDGSL",$J)) W !!,?15,"*** NO GREEN SHEET DATA ***",!! G DONE
|
|---|
| 10 | 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
|
|---|
| 11 | .Q:PSDOUT
|
|---|
| 12 | .S NODE=^TMP("PSDGSL",$J,PSD,PSDT,PSDJ),STATN=$P(NODE,"^"),CSTATN=$P(NODE,"^",2),PSDRN=$P(NODE,"^",3),NAOUN=$P(NODE,"^",4)
|
|---|
| 13 | .D:$Y+4>IOSL HDR Q:PSDOUT
|
|---|
| 14 | .W !,PSD,?12,PSDRN,?45,PSDT,?78,NAOUN,?90,$E(STATN,1,38),!,?90,$E(CSTATN,1,38),!
|
|---|
| 15 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 16 | 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
|
|---|
| 17 | END K %,%DT,%H,%I,%ZIS,ASK,CSTAT,CSTATN,DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,LN,LOC,NAOU,NAOUN,NODE,OK
|
|---|
| 18 | K PG,POP,PSD,PSD1,PSD2,PSDATE,PSDED,PSDEV,PSDJ,PSDL,PSDOUT,PSDPN,PSDR,PSDRN,PSDS,PSDSD,PSDSN,PSDT,STAT,STATN,TYPE,X,Y
|
|---|
| 19 | K ^TMP("PSDGSL",$J)
|
|---|
| 20 | K ZTDESC,ZTRTN,ZTSAVE,ZTSK D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 21 | Q
|
|---|
| 22 | GS ;green sheet num sort
|
|---|
| 23 | 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
|
|---|
| 24 | Q
|
|---|
| 25 | DATE ;date sort
|
|---|
| 26 | 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
|
|---|
| 27 | ;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
|
|---|
| 28 | Q
|
|---|
| 29 | SET ;set data
|
|---|
| 30 | Q:'$D(^PSD(58.81,PSDJ,0)) S NODE=^PSD(58.81,PSDJ,0)
|
|---|
| 31 | 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
|
|---|
| 32 | S PSDPN=$P(NODE,"^",17) Q:PSDPN']""
|
|---|
| 33 | S (PSDT,Y)=+$E($P(NODE,"^",4),1,12) X ^DD("DD") S PSDT=Y
|
|---|
| 34 | S STAT=+$P(NODE,"^",11),STATN=$P($G(^PSD(58.82,STAT,0)),"^")
|
|---|
| 35 | Q:STAT=10
|
|---|
| 36 | 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)),"^")
|
|---|
| 37 | S PSDR=+$P(NODE,"^",5),PSDRN=$P($G(^PSDRUG(PSDR,0)),"^")
|
|---|
| 38 | S ^TMP("PSDGSL",$J,PSDPN,PSDT,PSDJ)=STATN_"^"_CSTATN_"^"_PSDRN_"^"_$E(NAOUN,1,10)
|
|---|
| 39 | Q
|
|---|
| 40 | HDR ;header
|
|---|
| 41 | 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
|
|---|
| 42 | S PG=PG+1
|
|---|
| 43 | W:$Y @IOF W !,?20,"CS GREEN SHEET LISTING REPORT",?70,"PAGE: ",PG
|
|---|
| 44 | W:ASK="D" !,?20,$P(PSDATE,"^")," to ",$P(PSDATE,"^",2)
|
|---|
| 45 | W:ASK="N" !,?20,"GS # ",$G(PSD1)," through ",$G(PSD2)
|
|---|
| 46 | W !,?20,"Dispensing Site: ",PSDSN,!
|
|---|
| 47 | W !,"GS #",?12,"DRUG",?45,"DATE DISP",?78,"NAOU",?90,"STATUS",!,LN,!
|
|---|
| 48 | Q
|
|---|
