source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDGSH1.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1PSDGSH1 ;BIR/JPW-Review Green Sheet History (cont'd) ; 6 Jan 94
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3START ;
4 S CNT=0,NODE15=$G(^PSD(58.81,PSDA,1.5)),NODE16=$G(^PSD(58.81,PSDA,1.6))
5 S PSDDT=$P(NODE,"^",4) I PSDDT S PSDDT=$$FMTE^XLFDT(PSDDT,"2P")
6 S MFG=$P(NODE,"^",13),LOT=$P(NODE,"^",14),EXP=$P(NODE,"^",15) I EXP S Y=EXP X ^DD("DD") S EXP=Y
7 S STAT=+$P(NODE,"^",11),PSDPN=$P(NODE,"^",17),STAT=$P($G(^PSD(58.82,STAT,0)),"^")
8 S NAOU=+$P(NODE,"^",18),NAOU=$P($G(^PSD(58.8,+NAOU,0)),"^"),DRUG=+$P(NODE,"^",5),DRUG=$P($G(^PSDRUG(+DRUG,0)),"^")
9 S COMP=+$P(NODE,"^",12),COMP=$P($G(^PSD(58.83,+COMP,0)),"^"),QTY=+$P(NODE,"^",6)
10 S CDT=$P(NODE,"^",19) I CDT S CDT=$$FMTE^XLFDT(CDT,"2P")
11 S REAS=$P(NODE,"^",16),PSDI=+$P(NODE,"^",7)
12 S PSDTP=$P(NODE15,"^",2),PSDIP=$P(NODE15,"^",3),PSDIR=$P(NODE15,"^",4)
13 S PSDUZA=$P(NODE15,"^",2)
14 I PSDUZA S PSDUZAN=$P($G(^VA(200,+PSDUZA,0)),"^")
15 I PSDTP S PSDTP=$$FMTE^XLFDT(PSDTP,"2P")
16 I PSDIP S PSDIP=$$FMTE^XLFDT(PSDIP,"2P")
17 I PSDIR S PSDIR=$$FMTE^XLFDT(PSDIR,"2P")
18 I PSDI S PSDIN=$P($G(^VA(200,+PSDI,0)),"^")
19 I $D(^PSD(58.81,PSDA,1)) S NODE1=^(1) D SET1^PSDGSH11
20 I $D(^PSD(58.81,PSDA,3)) S NODE3=^(3) D SET3^PSDGSH11
21 I $D(^PSD(58.81,PSDA,4)) S NODE4=^(4) D SET4^PSDGSH11
22 I $D(^PSD(58.81,PSDA,5)) S NODE5=^(5) D SET5^PSDGSH11
23 I $D(^PSD(58.81,PSDA,7)) S NODE7=^(7) D SET7^PSDGSH11
24 I $D(^PSD(58.81,PSDA,1.5)) S NODE15=^(1.5) D SET15^PSDGSH11
25 I $D(^PSD(58.81,PSDA,1.6)) S NODE16=^(1.6)
26 D DISPLAY^PSDGSH2
27DONE I $E(IOST)'="C" W @IOF
28 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
29END K %,%DT,%H,%I,%ZIS,C,CANCD,CANCPH,CANCQ,CBY,CDT,CNT,COMP,CREAS,COMM,D,DA,DESD,DESDP,DEST,DESTD,DESTH,DESTQ,DIC,DIW,DIWF,DIWL,DIWR,DIWT,DN,DREAS,DRUG,DTOUT,DUOUT
30 K EDADJ,EDMFG,EDPH,EDQTY,EDT,EREAS,EXP,FILL,JJ,LN,LOT,MFG,NAOU,NEW,NODE,NODE1,NODE3,NODE4,NODE5,NODE7,NODE15,NODE16,NURSF,NURST,OK,ORC,ORCD,OTR
31 K PG,PROC,POP,PSDA,PSDBY,PSDDT,PSDEV,PSDI,PSDIN,PSDIP,PSDIR,PSDOUT,PSDPN,PSDTP,PSDUZA,PSDUZAN,PUBY,PUDT
32 K QTY,REAS,REQ,REQD,RETN,RTECH,SREAS,STAT,STATN,STKD,STKQ,TEXT,TFRD,TFRN,TFTD,TFTN,TQTY,TRANS,TRN,X,Y,Z
33 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
34 Q
Note: See TracBrowser for help on using the repository browser.