| [613] | 1 | PSGLPI ;BIR/CML3-PATIENT INFO FOR LABELS ;15 DEC 95 / 10:26 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ENPI ;
|
|---|
| 5 | N VADM,VAIN,VAIP,PSGLWG S DFN=PSGOP D DEM^VADPT,INP^VADPT S PSGLPID=VA("PID"),PSGLBID=VA("BID")
|
|---|
| 6 | I 'VAIN(4) S VAIP("D")="L" D IN5^VADPT
|
|---|
| 7 | I VAIN(4) S PSGLWD=+VAIN(4),PSGLWDN=$P(VAIN(4),"^",2) S PSGLPR=VAIN(2),PSGLTS=VAIN(3),PSGLRB=VAIN(5),PSGLAD=+VAIN(7),PSGLDX=VAIN(9)
|
|---|
| 8 | E S:$S('$D(PSGLWD):1,1:'PSGLWD) PSGLWD=+VAIP(5),PSGLWDN=$P(VAIP(5),"^",2) S PSGLRB=$P(VAIP(6),"^",2),PSGLPR=VAIP(7),PSGLTS=VAIP(8),PSGLDX=VAIP(9)
|
|---|
| 9 | S PSGLTM="" I PSGLWD,PSGLRB]"",$D(^PS(57.7,PSGLWD,1,+$O(^PS(57.7,"AWRT",PSGLWD,PSGLRB,0)),0)) S PSGLTM=$P(^(0),"^")
|
|---|
| 10 | D NOW^%DTC S PSGLDT=+$E(%,1,12)
|
|---|
| 11 | S PSGLPN=VADM(1),PSGLSSN=$P(VADM(2),"^",2),PSGLDOB=$E($$ENDTC^PSGMI(+VADM(3)),1,8),PSGLAGE=VADM(4),PSGLSEX=$S(VADM(5)]"":$P(VADM(5),"^",2),1:"____")
|
|---|
| 12 | S PSGLBS5=$E(PSGLPN)_$P(PSGLSSN,"-",3) I $S('$D(PSGLWG):1,1:'PSGLWG) S (PSGLWG,PSGLWGN)="" S PSGLWG=$O(^PS(57.5,"AB",PSGLWD,0)) I PSGLWG,$D(^PS(57.5,PSGLWG,0)) S PSGLWGN=$P(^(0),"^")
|
|---|
| 13 | ;
|
|---|
| 14 | DONE ;
|
|---|
| 15 | K PSGLPIWF,PSGID,PSGOD,VADM,VAIN,VAIP Q
|
|---|
| 16 | ;
|
|---|
| 17 | ENPVSET ;
|
|---|
| 18 | S PSGLAD=+PSJPAD,PSGLAGE=PSJPAGE,PSGLBS5=$E(PSGP(0))_$E($P(PSJPSSN,"^"),6,10),PSGLDOB=$E($P(PSJPDOB,"^",2),1,8),PSGLDX=PSJPDX,PSGLPN=$P(PSGP(0),"^"),PSGLRB=PSJPRB,PSGLSEX=$P(PSJPSEX,"^",2),PSGLSSN=VA("PID"),PSGLWD=PSJPWD,PSGLWDN=PSJPWDN
|
|---|
| 19 | I $S('$D(PSGLWG):1,1:'PSGLWG) S (PSGLWG,PSGLWGN)="" I PSGLWD S PSGLWG=$O(^PS(57.5,"AB",PSGLWD,0)) I PSGLWG,$D(^PS(57.5,PSGLWG,0)) S PSGLWGN=$P(^(0),"^")
|
|---|
| 20 | S PSGLTM="" I PSGLWD,PSGLRB]"",$D(^PS(57.7,PSGLWD,1,+$O(^PS(57.7,"AWRT",PSGLWD,PSGLRB,0)),0)) S PSGLTM=$P(^(0),"^")
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | ENHEDER ; Print MAR header labels.
|
|---|
| 24 | N NF S NF="NOT FOUND"
|
|---|
| 25 | W *13,?52,PSGLPN,?88,$J($S(PSGLRB]"":PSGLRB,1:"*NF*"),12)
|
|---|
| 26 | W !?(41-$L(PSGLPN)/2),"*** ",PSGLPN," ***",?52,PSGLSSN,?70,PSGLDOB," (",PSGLAGE,")",?85,$J($S(PSGLTM]"":PSGLTM,1:NF),15)
|
|---|
| 27 | W !?18,PSGLSSN,?52,$S(PSGLSEX]"":PSGLSEX,1:"____"),?65,"DX: ",PSGLDX
|
|---|
| 28 | D NOW^%DTC W !?52,$$ENDTC^PSGMI(%),!?52,$S(PSGLWGN]"":$E(PSGLWGN,1,21),1:NF),?79,$J($S(PSGLWDN]"":PSGLWDN,1:NF),21),!!
|
|---|
| 29 | Q
|
|---|
