| 1 | PSGAP ;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 |  ;
 | 
|---|
| 6 | START ;
 | 
|---|
| 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 |  ;
 | 
|---|
| 12 | DONE ;
 | 
|---|
| 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 |  ;
 | 
|---|
| 18 | G ; get ward group
 | 
|---|
| 19 |  S PSGAPWG=+PSJSEL("WG"),PSGAPWGN=$P(PSJSEL("WG"),"^",2) Q
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 | W ; 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 |  ;
 | 
|---|
| 26 | P ; 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 |  ;
 | 
|---|
| 30 | ENOR ;
 | 
|---|
| 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
 | 
|---|
| 33 | ENLM ;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
 | 
|---|