PSOQ0236 ;HINES/RMS - HS VERSION PRE-ADMISSION RX PROFILE ; 11 Feb 2008 9:42 AM
;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
;
;Reference to BCMALG^PSJMUTL supported by DBIA 5058
;Reference to LIST^TIULMED supported by DBIA 5129
RPT S PSOQDFN=DFN
S TIUDATE=180,PSOQT=$$LIST^TIULMED(PSOQDFN,"PSOQR",0,0,3)
S PSOQPTNM=$P(^DPT(PSOQDFN,0),"^")
D CKP^GMTSUP Q:$D(GMTSQIT) ;->
D CKP^GMTSUP Q:$D(GMTSQIT)
D ATS^PSJMUTL(68,68,1) W !,"Allergies: " D:+PSGVALG
. F I=1:1 W PSGVALG(I)_", " Q:'$D(PSGVALG(I+1))
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"Adverse Reactions: " D:+PSGVADR W:'+PSGVADR "NONE"
. F I=1:1 W PSGVADR(I)_", " Q:'$D(PSGVADR(I+1))
W !! S PSOQL=0 F S PSOQL=$O(PSOQR(PSOQL)) Q:PSOQL'=+PSOQL Q:$G(PSOQSTOP) D ;
. W !,PSOQR(PSOQL,0) D CKP^GMTSUP Q:$D(GMTSQIT) ;->
K PSOQ,PSOQDFN,PSOQL,PSOQR,PSOQT,PSOQPTNM,VADM,PSGP,PSGVALG,PSGVADR
K PSOQSTOP,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,X,Y,VA,VAERR,PSGADR,PSGALG
K TIUDATE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOQ0236 962 printed Dec 13, 2024@02:33:17 Page 2
PSOQ0236 ;HINES/RMS - HS VERSION PRE-ADMISSION RX PROFILE ; 11 Feb 2008 9:42 AM
+1 ;;7.0;OUTPATIENT PHARMACY;**294**;DEC 1997;Build 13
+2 ;
+3 ;Reference to BCMALG^PSJMUTL supported by DBIA 5058
+4 ;Reference to LIST^TIULMED supported by DBIA 5129
RPT SET PSOQDFN=DFN
+1 SET TIUDATE=180
SET PSOQT=$$LIST^TIULMED(PSOQDFN,"PSOQR",0,0,3)
+2 SET PSOQPTNM=$PIECE(^DPT(PSOQDFN,0),"^")
+3 ;->
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+5 DO ATS^PSJMUTL(68,68,1)
WRITE !,"Allergies: "
if +PSGVALG
Begin DoDot:1
+6 FOR I=1:1
WRITE PSGVALG(I)_", "
if '$DATA(PSGVALG(I+1))
QUIT
End DoDot:1
+7 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+8 WRITE !,"Adverse Reactions: "
if +PSGVADR
Begin DoDot:1
+9 FOR I=1:1
WRITE PSGVADR(I)_", "
if '$DATA(PSGVADR(I+1))
QUIT
End DoDot:1
if '+PSGVADR
WRITE "NONE"
+10 ;
WRITE !!
SET PSOQL=0
FOR
SET PSOQL=$ORDER(PSOQR(PSOQL))
if PSOQL'=+PSOQL
QUIT
if $GET(PSOQSTOP)
QUIT
Begin DoDot:1
+11 ;->
WRITE !,PSOQR(PSOQL,0)
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:1
+12 KILL PSOQ,PSOQDFN,PSOQL,PSOQR,PSOQT,PSOQPTNM,VADM,PSGP,PSGVALG,PSGVADR
+13 KILL PSOQSTOP,DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,X,Y,VA,VAERR,PSGADR,PSGALG
+14 KILL TIUDATE
+15 QUIT
