| 1 | PSDPWK1 ;BIR/JPW-Print Pharm Disp. Worksheet (cont'd) ; 17 Oct 93 | 
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97 | 
|---|
| 3 | START ;compile data | 
|---|
| 4 | K ^TMP("PSDWK",$J),^TMP("PSDWKT",$J) S PRT=0 | 
|---|
| 5 | 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),"^",4)=+PSDS S NAOU(PSDN)="",CNT=CNT+1 | 
|---|
| 6 | F JJ=0:0 S JJ=$O(^PSD(58.85,"AW",+PSDS,JJ)) Q:'JJ  S JJDA=+$O(^PSD(58.85,"AW",+PSDS,JJ,0)) I JJDA D:$D(ALL)!($D(NAOU(+$P($G(^PSD(58.85,JJDA,0)),U,3)))) | 
|---|
| 7 | .K ^PSD(58.85,"AW",+PSDS,JJ,JJDA) S:$D(^PSD(58.85,JJDA,2)) ^PSD(58.85,JJDA,2)="" | 
|---|
| 8 | F PSD=0:0 S PSD=$O(^PSD(58.85,"AE",+PSDS,PSD)) Q:'PSD  I $D(^PSD(58.85,PSD,0)) S PSDN=+$P(^(0),"^",3) I $D(ALL)!$D(NAOU(PSDN)) D | 
|---|
| 9 | .Q:+$P(^PSD(58.85,PSD,0),"^",7)>2 | 
|---|
| 10 | .S PSDNA=$S($P($G(^PSD(58.8,PSDN,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDN) | 
|---|
| 11 | .S PSDR=+$P(^PSD(58.85,PSD,0),"^",4),PSDRN=$S($P($G(^PSDRUG(PSDR,0)),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSDR) S:'$D(^TMP("PSDWKT",$J,PSDRN,PSDNA)) ^TMP("PSDWKT",$J,PSDRN,PSDNA)=0 | 
|---|
| 12 | .S QTY=$P(^PSD(58.85,PSD,0),"^",6) S ^TMP("PSDWKT",$J,PSDRN,PSDNA)=^TMP("PSDWKT",$J,PSDRN,PSDNA)+QTY | 
|---|
| 13 | .S ORD=+$P(^PSD(58.85,PSD,0),"^",12),ORDN=$S($P($G(^VA(200,ORD,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN") | 
|---|
| 14 | .S COMM=$S($D(^PSD(58.85,PSD,1,0)):1,1:0) | 
|---|
| 15 | .I (CNT=1)!(ANS="N") S ^TMP("PSDWK",$J,PSDNA,PSDRN,PSD)=QTY_"^"_ORDN_"^"_COMM | 
|---|
| 16 | .I ANS="D",CNT'=1 S ^TMP("PSDWK",$J,PSDRN,PSDNA,PSD)=QTY_"^"_ORDN_"^"_COMM | 
|---|
| 17 | S JJ="" F  S JJ=$O(^TMP("PSDWK",$J,JJ)) Q:JJ=""  S JJ1="" F  S JJ1=$O(^TMP("PSDWK",$J,JJ,JJ1)) Q:JJ1=""  F JJDA=0:0 S JJDA=$O(^TMP("PSDWK",$J,JJ,JJ1,JJDA)) Q:'JJDA  D | 
|---|
| 18 | .S PRT=PRT+1 K DA,DIE,DR S DIE=58.85,DA=JJDA,DR="13////"_PRT D ^DIE K DA,DIE,DR | 
|---|
| 19 | G:'$D(ZTQUEUED) PRINT^PSDPWK2 | 
|---|
| 20 | PRTQUE ;queues print after compile | 
|---|
| 21 | K ZTSAVE,ZTIO S ZTIO=PSDIO,ZTRTN="PRINT^PSDPWK2",ZTDESC="Print Worksheet for CS PHARM",ZTDTH=$H | 
|---|
| 22 | S (ZTSAVE("^TMP(""PSDWK"",$J,"),ZTSAVE("^TMP(""PSDWKT"",$J,"),ZTSAVE("PSDS*"),ZTSAVE("ANS"),ZTSAVE("CNT"),ZTSAVE("SUM"))="" | 
|---|
| 23 | D ^%ZTLOAD K ^TMP("PSDWK",$J),^TMP("PSDWKT",$J),ZTSK | 
|---|
| 24 | END K %,%H,%I,%ZIS,ALL,ANS,C,CNT,COMM,DA,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,DUOUT,IO("Q"),JJ,JJ1,JJDA,LOOP,LOOP2,NAOU,NODE | 
|---|
| 25 | K OK,ORD,ORDN,PG,POP,PRT,PSD,PSDCPY,PSDEV,PSDG,PSDIO,PSDN,PSDNA,PSDOUT,PSDR,PSDRN,PSDS,PSDSN,PSDT,PSDSN | 
|---|
| 26 | K QTY,SEL,SUM,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("PSDWK",$J),^TMP("PSDWKT",$J) D ^%ZISC | 
|---|
| 27 | S:$D(ZTQUEUED) ZTREQ="@" | 
|---|
| 28 | Q | 
|---|