PSOQ0236.m

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

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