- 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 Jan 18, 2025@03:34:25 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