| [613] | 1 | PSDLBLP ;B'ham ISC/JPW - CS Print for Patient ID List ; 2 Mar 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
|
|---|
| 4 | ;I '$D(^XUSEC("PSJ RNURSE",DUZ)) W !!,"Contact your Pharmacy Coordinator. You do not have the Supervisor",!,"access required to print labels.",!!
|
|---|
| 5 | ASK ;ask naou or ward
|
|---|
| 6 | S PSDOUT=0 N PSD2
|
|---|
| 7 | K DA,DIR,DIRUT S DIR(0)="SO^N:Nursing Location;W:Ward",DIR("A",1)="You may select Nursing Location or Ward to print the Patient ID List."
|
|---|
| 8 | S DIR("?",1)="Enter 'N' to select Nursing Location to print list",DIR("?")="Enter 'W' to select Ward to print list."
|
|---|
| 9 | S DIR("A")="Select Method" D ^DIR K DIR G:$D(DIRUT) END S ANS=Y
|
|---|
| 10 | I Y="N" D ASKN G:PSDOUT END G DEV
|
|---|
| 11 | WARD ;ask ward name
|
|---|
| 12 | W ! K DA,DIC
|
|---|
| 13 | F S DIC=42,DIC(0)="QEAM",DIC("A")="Select Ward to print Patient ID List: " D ^DIC G:$D(DTOUT)!($D(DUOUT))!((X="")&('$D(PSDW))) END Q:X="" D
|
|---|
| 14 | .S PSDW($P(Y,"^",2))=+Y_"^"_$P(Y,"^",2),PSDWN=$P(Y,"^",2)
|
|---|
| 15 | K DIC
|
|---|
| 16 | DEV S DIR(0)="SO^A:Alphabetical;R:Room-Bed",DIR("A")="Sort"
|
|---|
| 17 | D ^DIR K DIR G:$D(DIRUT) END S ANS(1)=Y
|
|---|
| 18 | ;ask device and queue info
|
|---|
| 19 | W !!,"This report is designed to print bar codes on a printer.",!,"You may queue this report to print at a later time.",!!
|
|---|
| 20 | K %ZIS,IOP,IO("Q"),POP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END
|
|---|
| 21 | I $D(IO("Q")) K IO("Q"),ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSDLBLP",ZTDESC="Print Patient ID List for CS PHARM" D SAVE,^%ZTLOAD,HOME^%ZIS K ZTSK G END
|
|---|
| 22 | U IO
|
|---|
| 23 | START ;entry for compile and print labels
|
|---|
| 24 | K ^TMP("PSDLBLP",$J),PSDPRT S PSDCNT=0 D NOW^%DTC S PSDT=%
|
|---|
| 25 | F JJ=0,1 S @("PSDBAR"_JJ)="" I $D(^%ZIS(2,^%ZIS(1,IOS,"SUBTYPE"),"BAR"_JJ)) S @("PSDBAR"_JJ)=^("BAR"_JJ)
|
|---|
| 26 | I PSDBAR1]"",PSDBAR0]"" S PSDPRT=1
|
|---|
| 27 | G:ANS(1)="R" ^PSDLBLB
|
|---|
| 28 | S PSDWN="" F S PSDWN=$O(PSDW(PSDWN)) Q:PSDWN="" F PSD1=0:0 S PSD1=$O(^DPT("ACN",PSDWN,PSD1)) Q:'PSD1 I $D(^DPT(PSD1,0)) D
|
|---|
| 29 | .S DFN=PSD1 D DEM^VADPT S PATN=$S('VAERR:VADM(1),1:"UNKNOWN"),SSN=$P(VADM(2),"^"),PATN=PATN_" ("_VA("BID")_")"
|
|---|
| 30 | .S VAINDT=PSDT D INP^VADPT S PSDRM=VAIN(5)
|
|---|
| 31 | .K DFN,VADM,VAIN,VAINDT
|
|---|
| 32 | .S PSDCNT=PSDCNT+1,^TMP("PSDLBLP",$J,PSDWN,PATN,PSDCNT)=SSN_"^"_PSDRM
|
|---|
| 33 | PRINT ;print labels
|
|---|
| 34 | S (PSDOUT,PG)=0,$P(LN,"-",80)="",(PSDX1,PSDCNT)=1
|
|---|
| 35 | I '$D(^TMP("PSDLBLP",$J)) D HDR W !!,?15,"**** NO PATIENT WARD INFO ****",!! G DONE
|
|---|
| 36 | S PSDN="" F S PSDN=$O(^TMP("PSDLBLP",$J,PSDN)) Q:PSDN=""!(PSDOUT) Q:PSDOUT D HDR D Q:PSDOUT
|
|---|
| 37 | .S PSD="" F S PSD=$O(^TMP("PSDLBLP",$J,PSDN,PSD)) Q:PSD=""!(PSDOUT) D:$Y+26>IOSL HDR Q:PSDOUT F PSD1=0:0 S PSD1=$O(^TMP("PSDLBLP",$J,PSDN,PSD,PSD1)) Q:'PSD1!(PSDOUT) S NODE=^(PSD1) D
|
|---|
| 38 | ..I $Y+26>IOSL D HDR Q:PSDOUT
|
|---|
| 39 | ..W !,PSD,?45,$P(NODE,"^",2)," ",$G(PSDN)
|
|---|
| 40 | ..W ! I $D(PSDPRT) W @PSDBAR1,$P(NODE,"^"),@PSDBAR0,!!
|
|---|
| 41 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 42 | 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
|
|---|
| 43 | END ;kill variables and exit
|
|---|
| 44 | D KVAR^VADPT K VA
|
|---|
| 45 | K %,%H,%ZIS,ANS,DA,DFN,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,JJ,JJ1,JJ2,LN,NODE,POP,PATN,PG,PSD,PSD1,PSDBAR0,PSDBAR1,PSDCNT,PSDN,PSDOUT
|
|---|
| 46 | K PSDPRT,PSDR,PSDRM,PSDT,PSDW,PSDWN,PSDX1,PSDX2,SSN,VADM,VAERR,VAIN,VAINDT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 47 | K ^TMP("PSDLBLP",$J)
|
|---|
| 48 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 49 | Q
|
|---|
| 50 | HDR ;prints header information
|
|---|
| 51 | I $E(IOST,1,2)="C-",PG K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
|
|---|
| 52 | S PG=PG+1,PSD(1)=0 W:$Y @IOF W !,"Patient ID List for "
|
|---|
| 53 | ;F S PSD(1)=$O(PSDW(PSD(1))) Q:PSD(1)']"" W PSD(1)
|
|---|
| 54 | W $S($G(PSD2)]"":PSD2,$G(PSDN)]"":PSDN,$G(NAOUN)]"":NAOUN,$O(PSDW(""))]"":$O(PSDW("")),1:"")
|
|---|
| 55 | W " Printed: ",$$HTE^XLFDT($H,"P"),?70,"Page: ",PG,!
|
|---|
| 56 | W "PATIENT",?45,"ROOM-BED",!,LN,!!
|
|---|
| 57 | Q
|
|---|
| 58 | SAVE ;save queued variables
|
|---|
| 59 | S ZTSAVE("PSDW(")="",ZTSAVE("PSD2")="",ZTSAVE("ANS(1)")=""
|
|---|
| 60 | S:$D(NAOUN) ZTSAVE("NAOUN")=""
|
|---|
| 61 | Q
|
|---|
| 62 | ASKN ;ask nursing location
|
|---|
| 63 | K DA,DIC S DIC=211.4,DIC(0)="QEA",DIC("A")="Select Nursing Location: "
|
|---|
| 64 | W ! D ^DIC K DIC I Y<0 S PSDOUT=1 Q
|
|---|
| 65 | N PSD S PSD2=$P($P($G(^SC(+$P(Y,U,2),0)),U)," ",2)
|
|---|
| 66 | D GETS^DIQ(211.4,+Y_",","2*","","PSD") S PSD(1)=0
|
|---|
| 67 | F S PSD(1)=$O(PSD(211.41,PSD(1))) Q:PSD(1)']"" D:$G(PSD(211.41,PSD(1),.01))]""
|
|---|
| 68 | .S PSDW($G(PSD(211.41,PSD(1),.01)))=0
|
|---|
| 69 | Q
|
|---|
| 70 | WARD2 W !!,"Compiling Ward data for ",NAOUN,"..."
|
|---|
| 71 | F JJ=0:0 S JJ=$O(^PSD(58.8,"D",JJ)) Q:'JJ F JJ1=0:0 S JJ1=$O(^PSD(58.8,"D",JJ,JJ1)) Q:'JJ1 F JJ2=0:0 S JJ2=$O(^PSD(58.8,"D",JJ,JJ1,JJ2)) Q:('JJ2)!(JJ2'=NAOU) D
|
|---|
| 72 | .Q:$P($G(^DIC(42,+JJ1,0)),"^")']""
|
|---|
| 73 | .S PSDW($P($G(^DIC(42,+JJ1,0)),"^"))=+JJ1_"^"_$P($G(^DIC(42,+JJ1,0)),"^")
|
|---|
| 74 | Q
|
|---|
