| 1 | PSGVBW1 ;BIR/CML3,MV-NON-VERFIED ORDERS UTILITES ;03 Jul 2003 7:19 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**5,111**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to ^PS(55 is supported by DBIA 2191.
|
|---|
| 5 | ;
|
|---|
| 6 | ENPROF ;
|
|---|
| 7 | I +PSJSYSU=1 S PSGOENOF=0 D NOW^%DTC F Q=%:0 S Q=$O(^PS(55,PSGP,5,"AUS",Q)) Q:'Q F QQ=0:0 S QQ=$O(^PS(55,PSGP,5,"AUS",Q,QQ)) Q:'QQ I $D(^PS(55,PSGP,5,QQ,4)),$P(^(4),"^",10) S PSGOENOF=1 Q
|
|---|
| 8 | W !!,$S($P(PSGP(0),"^")]"":$P(PSGP(0),"^"),1:PSGP_";DPT(") W:PSJPBID " (",PSJPBID,")"
|
|---|
| 9 | D ENL^PSGOU Q:PSGOL["^"
|
|---|
| 10 | K ZTSAVE S PSGTIR="^PSJAC,^PSGO",ZTDESC="PATIENT PROFILE",PSGPR=1 F X="PSGP","PSGP(0)","PSGPR","PSGOL","PSGPTMP","PPAGE" S ZTSAVE(X)=""
|
|---|
| 11 | Q:PSGOL="N"
|
|---|
| 12 | D ENDEV^PSGTI K PSGPR Q:POP!$D(IO("Q"))
|
|---|
| 13 | S PSGVBW=IO'=IO(0)!($E(IOST)'="C") D ^PSGO D ^%ZISC Q:PSGVBW
|
|---|
| 14 | PEND K DIR S DIR(0)="E" W ! D ^DIR K DIR Q
|
|---|
| 15 | ;
|
|---|
| 16 | OUTPT ;Set up Outpatient IV for non/ver pending option.
|
|---|
| 17 | K ^TMP("PSGVBW",$J)
|
|---|
| 18 | NEW PSJSTAT,PSJTOO1,PSJPAC1
|
|---|
| 19 | ;I PSJTOO'=2 S PSJSTAT="N" D PSGP
|
|---|
| 20 | ;I PSJTOO'=1 S PSJSTAT="P" D PSGP
|
|---|
| 21 | S PSJSTAT="N" D PSGP
|
|---|
| 22 | S PSJSTAT="P" D PSGP
|
|---|
| 23 | D ^PSGVBW0
|
|---|
| 24 | S Y=-1
|
|---|
| 25 | Q
|
|---|
| 26 | PSGP ;
|
|---|
| 27 | F PSGP=0:0 S PSGP=$O(^PS(53.1,"AS",PSJSTAT,PSGP)) Q:'PSGP D
|
|---|
| 28 | . NEW VAIN S DFN=PSGP D INP^VADPT
|
|---|
| 29 | . I '+VAIN(4)!(PSGSS="G"&'$D(^PS(57.5,"AB",+VAIN(4)))) D
|
|---|
| 30 | .. ;I PSJSTAT="N",'+VAIN(4) Q
|
|---|
| 31 | .. D ^PSJAC S WDN="ZZ" D IF^PSGVBW
|
|---|
| 32 | Q
|
|---|
