| [613] | 1 | PSDCORP3 ;BIR/JPW-CS Correction Log Deleted Green Sheets ; 2 Aug 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | START ;
|
|---|
| 4 | K ^TMP("PSDCOR3",$J)
|
|---|
| 5 | F PSD=PSDSD:0 S PSD=$O(^PSD(58.87,"AC",TYPE,PSDS,PSD)) Q:'PSD!(PSD>PSDED) F PSDA=0:0 S PSDA=$O(^PSD(58.87,"AC",TYPE,PSDS,PSD,PSDA)) Q:'PSDA I $D(^PSD(58.87,PSDA,0)) D
|
|---|
| 6 | .S NODE=^PSD(58.87,PSDA,0),PSDPN=$S($P(NODE,"^",4)]"":$P(NODE,"^",4),1:"UNKNOWN")
|
|---|
| 7 | .S DRUG=+$P(NODE,"^",5),DRUGN=$S($P($G(^PSDRUG(DRUG,0)),"^")]"":$P(^(0),"^"),1:"DRUG NAME MISSING")
|
|---|
| 8 | .S CURR=+$P(NODE,"^",15),PREV=+$P(NODE,"^",14),CURR=$P($G(^PSD(58.83,CURR,0)),"^"),PREV=$P($G(^PSD(58.83,PREV,0)),"^")
|
|---|
| 9 | .S NAOU=+$P(NODE,"^",6),NAOUN=$S($P($G(^PSD(58.8,NAOU,0)),"^")]"":$P(^(0),"^"),1:"NAOU NAME MISSING")
|
|---|
| 10 | .S TECH=+$P(NODE,"^",10),TECHN=$S($P($G(^VA(200,TECH,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
|
|---|
| 11 | .S PHARM=+$P(NODE,"^",3),PHARMN=$S($P($G(^VA(200,PHARM,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN") I PHARMN'="UNKNOWN" S PHARMN=$P(PHARMN,",")_","_$E($P(PHARMN,",",2))
|
|---|
| 12 | .S Y=PSD X ^DD("DD") S PSDT=Y
|
|---|
| 13 | .S ^TMP("PSDCOR3",$J,NAOUN,PSDPN,PSDA)=DRUGN_"^"_PSDT_"^"_PHARMN_"^"_TECHN_"^"_CURR_"^"_PREV
|
|---|
| 14 | PRINT ;prints log
|
|---|
| 15 | K LN S (PG,PSDOUT)=0,$P(LN,"-",132)="" D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
|
|---|
| 16 | I '$D(^TMP("PSDCOR3",$J)) D HDR W !!,?20,"** NO GREEN SHEET DELETIONS REPORTED FROM ",$P(PSDATE,"^")," TO ",$P(PSDATE,"^",2)," **",!! G DONE
|
|---|
| 17 | D HDR S PSD="" F S PSD=$O(^TMP("PSDCOR3",$J,PSD)) Q:PSD=""!(PSDOUT) W !,?5,"=> ",PSD,! D
|
|---|
| 18 | .S NUM="" F S NUM=$O(^TMP("PSDCOR3",$J,PSD,NUM)) Q:NUM=""!(PSDOUT) F JJ=0:0 S JJ=$O(^TMP("PSDCOR3",$J,PSD,NUM,JJ)) Q:'JJ!(PSDOUT) D
|
|---|
| 19 | ..S NODE=^TMP("PSDCOR3",$J,PSD,NUM,JJ)
|
|---|
| 20 | ..I $Y+4>IOSL D HDR Q:PSDOUT W !,?5,"=> ",PSD,!!
|
|---|
| 21 | ..W NUM,?12,$P(NODE,"^"),?54,$P(NODE,"^",2),?76,$P(NODE,"^",3),?100,$P(NODE,"^",4),!,?15,"*",CURR,?65,"*",PREV,!
|
|---|
| 22 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 23 | 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
|
|---|
| 24 | END K %,%DT,%H,%I,C,CURR,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DRUG,DRUGN,DTOUT,DUOUT,IO("Q"),JJ,LN
|
|---|
| 25 | K NAOU,NAOUN,NODE,NUM,PHARM,PHARMN,PG,POP,PREV,PSD,PSDA,PSDATE,PSDED,PSDEV,PSDPN,PSDOUT,PSDOUT,PSDS,PSDSD,PSDSN,PSDT,RPDT,TECH,TECHN,TYPE,X,Y
|
|---|
| 26 | K ^TMP("PSDCOR3",$J),ZTDESC,ZTIO,ZTRTN,ZTSAVE D ^%ZISC
|
|---|
| 27 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 28 | Q
|
|---|
| 29 | HDR ;header for log
|
|---|
| 30 | 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
|
|---|
| 31 | S PG=PG+1 W:$Y @IOF W !,?25,"CS CORRECTION LOG - COMPLETED STATUS CHANGES",?115,"Page: ",PG,!,?25,"Report Range ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!,?25,"Report Printed: ",RPDT,!
|
|---|
| 32 | W !!,?5,"=> NAOU",!,?57,"DATE",?74,"CORRECTED BY"
|
|---|
| 33 | W !,"DISP #",?12,"DRUG",?54,"CORRECTED",?75,"PHARMACIST",?100,"ENTERED BY PHARMACIST",!,?15,"*CURRENT STATUS",?65,"*PREVIOUS STATUS",!,LN,!
|
|---|
| 34 | Q
|
|---|
