source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGVBW1.m@ 1259

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PSGVBW1 ;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 ;
6ENPROF ;
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
14PEND K DIR S DIR(0)="E" W ! D ^DIR K DIR Q
15 ;
16OUTPT ;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
26PSGP ;
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
Note: See TracBrowser for help on using the repository browser.