source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGAP.m@ 1288

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

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1PSGAP ;BIR/CML3-ACTION PROFILE (#1) ;12 Mar 98 / 9:28 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**8,111**;16 DEC 97
3 N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
4 D ENCV^PSGSETU I $D(XQUIT) Q
5 ;
6START ;
7 N PSGWD,PSJPWDO
8 S (PSGP,PSGAPWD,PSGAPWG)=0,(PSGAPWDN,PSGAPWGN)="",PSGSSH="AP",PSGY=1 S PSGPTMP=0,PPAGE=1 D GWP^PSJPDIR G:'$D(PSJSEL)!($G(PSJSTOP)=1) DONE D @PSJSEL("SELECT")
9 S PSGSS=PSJSEL("SELECT") D EN^PSGAP0
10 G:$G(PSJSTOP) START
11 ;
12DONE ;
13 D ENKV^PSGSETU K CA,CNTR,DFN,DIAG,DO,DRG,FD,N,NF,ND,ND2,PSJJORD,PAGE,PDOB,PN,PND,PSEX,PSGAP,PSGAPTM,PSGAPWD,PSGAPWDN,PSGAPWG,PSGAPWGN,PSGDICA,PSGPAT,PSGSS,PSGSSH
14 K PFLG,QFLG,PSGMTYPE,PSGFL,PSGEXPDT,PSGY,PSJSI,PSJSTOP,PSJACNWP,PSJOPC,PSJSEL,PT,RB,RTE,SD,SI,SM,ST,STRT,STP,STT,TM,WS,WT,ZTOUT,ZTSK,PSJDLW
15 K ^TMP($J)
16 Q
17 ;
18G ; get ward group
19 S PSGAPWG=+PSJSEL("WG"),PSGAPWGN=$P(PSJSEL("WG"),"^",2) Q
20 ;
21W ; get ward (and Admin. Team if present)
22 S (PSGWD,PSGAPWD)=+PSJSEL("W"),PSGAPWDN=$P(PSJSEL("W"),"^",2)
23 I $D(PSJSEL("TM")) S TM="",PSJTEAM=1 F S TM=$O(PSJSEL("TM",TM)) Q:TM="" S PSGAPTM(TM)=TM
24 Q
25 ;
26P ; get patient
27 S PT="" F S PT=$O(PSJSEL("P",PT)) Q:PT="" S DFN="",DFN=$O(PSJSEL("P",PT,DFN)) Q:'DFN S PSGPAT(DFN)=""
28 Q
29 ;
30ENOR ;
31 D ENCV^PSGSETU I $D(XQUIT) Q
32 S PSGP=+ORVP D PSJAC2^PSJAC(1) S PSGPAT=PSGP,PSGPAT(DFN)="",(PSGAPWD,PSGAPWG)=0,(PSGAPWDN,PSGAPWGN)="",PSGSS="P" D EN^PSGAP0 S PSJNKF=1 G DONE
33ENLM ;Entry point from PSJ LM AP1 protocol
34 N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
35 S PSGPTMP=0,PPAGE=1,PSGSSH="AP",PSGY=1
36 D ENCV^PSGSETU I $D(XQUIT) Q
37 S PSGPAT=PSGP,PSGPAT(DFN)="",(PSGAPWD,PSGAPWG)=0,(PSGAPWDN,PSGAPWGN)="",PSGSS="P" D EN^PSGAP0 S PSJNKF=1 G DONE
Note: See TracBrowser for help on using the repository browser.