GMRADSP2.m

GMRADSP2 ;HIRMFO/RM,WAA-PRINT PATIENT A/AR ;01-May-2012 14:15;DU

 ;;4.0;Adverse Reaction Tracking;**21,1002,1006**;Mar 29, 1996;Build 29

 ;IHS/MSC/MGH  added data for source patch 1002,1006

EN1 ; ENTRY TO PRINT DATA FOR A SINGLE RECORD DENOTED BY GMRAPA

 S GMRAOUT=0

 S GMRAPA(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"")

 ;IHS/MSC/MGH added back patch 1006

 S GMRAPA(9999999.11)=$S($D(^GMR(120.8,GMRAPA,9999999.11)):^(9999999.11),1:"")

 S DFN=$P(GMRAPA(0),"^") D DEM^VADPT S GMRANAM=VADM(1) D KVAR^VADPT K VA

 S GMRADRUG=$S($P(GMRAPA(0),U,20)["D":1,1:0)

 S GMRAERR=$S($D(^GMR(120.8,GMRAPA,"ER")):+^("ER"),1:0) S:'$D(GMRAPG) GMRAPG=0

 D:$Y+3>IOSL EOP^GMRADSP3 G:GMRAOUT EXIT

 ;D:'GMRAPG HDR^GMRADSP3

 I 'GMRAPRNT S GMRASP(1)=7,GMRAHDR(1)="PATIENT: ",GMRALIN(1)=$E(GMRANAM,1,23),GMRASP(2)=41,GMRAHDR(2)="CAUSATIVE AGENT: ",GMRALIN(2)=$E($P(GMRAPA(0),"^",2),1,21) D WRITE^GMRADSP3 G:GMRAOUT EXIT ;21

 I GMRAPRNT S GMRASP(1)=9,GMRAHDR(1)="AGENT: ",GMRALIN(1)=$E($P(GMRAPA(0),"^",2),1,23),GMRASP(2)="" D WRITE^GMRADSP3 G:GMRAOUT EXIT

 G:'GMRADRUG ORIG S (GMRADI,GMRADC)=0,GMRAFT=1

DICL ;

 S:GMRADI'="" GMRADI=$O(^GMR(120.8,GMRAPA,2,GMRADI)) S:GMRADC'="" GMRADC=$O(^GMR(120.8,GMRAPA,3,GMRADC)) G:GMRADI'>0&(GMRADC'>0)&'GMRAFT ORIG

 S GMRASP(1)=$S(GMRAFT:3,'GMRADI:"",1:16),GMRAHDR(1)=$S(GMRAFT:"INGREDIENTS: ",1:""),X=$S($D(^GMR(120.8,GMRAPA,2,+GMRADI,0)):^(0),1:""),GMRALIN(1)=$E($S($D(^PS(50.416,+X,0)):$P(^(0),"^"),1:""),1,23)

 S GMRASP(2)=$S(GMRAFT:41,'GMRADC:"",1:58),GMRAHDR(2)=$S(GMRAFT:"VA DRUG CLASSES: ",1:""),X=$S($D(^GMR(120.8,GMRAPA,3,+GMRADC,0)):^(0),1:""),GMRALIN(2)=$E($S($D(^PS(50.605,+X,0)):$P(^(0),"^",2),1:""),1,21)

 D WRITE^GMRADSP3 G:GMRAOUT EXIT S GMRAFT=0 G DICL

ORIG ;

 S GMRAREA=0,GMRATRT=0

 S (GMRASP(1),GMRASP(2))="" D WRITE^GMRADSP3 G:GMRAOUT EXIT

 ;IHS/MSC/MGH added back patch 1006

 I $P($G(^GMR(120.8,GMRAPA,9999999.11)),U,1)'="" D

 .S GMRASP(1)=6,GMRAHDR(1)="SOURCE OF INFORMATION: ",GMRALIN(1)=$$GET1^DIQ(120.8,GMRAPA,9999999.11)

 .D WRITE^GMRADSP3 G:GMRAOUT EXIT

 ;end mod

 S Y=$P(GMRAPA(0),"^",4) S:Y Y=$$FMTE^XLFDT(Y) S GMRASP(1)=4,GMRAHDR(1)="ORIGINATOR: ",GMRALIN(1)=$$GET1^DIQ(200,$P(GMRAPA(0),U,5)_",",".01") ;21

 S GMRASP(2)=46,GMRAHDR(2)="ORIGINATED: ",GMRALIN(2)=Y D WRITE^GMRADSP3 G:GMRAOUT EXIT

 S GMRASP(1)=6,GMRAHDR(1)="SIGN OFF: ",GMRALIN(1)=$S($P(GMRAPA(0),"^",12)=1:"YES",1:"NO"),GMRASP(2)=48,GMRAHDR(2)="OBS/HIST: ",GMRALIN(2)=$S($P(GMRAPA(0),"^",6)="o":"OBSERVED",$P(GMRAPA(0),"^",6)="h":"HISTORICAL",1:"")

 D WRITE^GMRADSP3 G:GMRAOUT EXIT

 ;IHS/MSC/MGH Mod added back patch 1006

 ;Printout the SNOMED event IHS/MSC/MGH

 S GMRSNO=$P(GMRAPA(9999999.11),"^",2)

 I +GMRSNO D

 .S SNOTXT=$P($G(^BEHOAR(90460.06,GMRSNO,0)),U,1),SNOCODE=$P($G(^BEHOAR(90460.06,GMRSNO,0)),U,2)

 .S GMRASP(1)=6,GMRAHDR(1)="EVENT: ",GMRALIN(1)=SNOTXT

 .S GNRASP(2)=46,GMRAHDR(2)="CODE: ",GMRALIN(2)=SNOCODE D WRITE^GMRADSP3

 .G:GMRAOUT EXIT

 .;end mod

 I $D(^GMR(120.85,"C",GMRAPA)) D  ;21

 .S (GMRASP(1),GMRASP(2))="" ;21

 .N GMRAI,SEVER S (GMRAI,SEVER)=0 F  S GMRAI=$O(^GMR(120.85,"C",GMRAPA,GMRAI)) Q:'+GMRAI  S:+$P(^GMR(120.85,GMRAI,0),U,14)>SEVER SEVER=$P(^(0),U,14) ;21

 .I $G(SEVER) S GMRASP(1)=6,GMRAHDR(1)="SEVERITY: ",GMRALIN(1)=$S(SEVER=1:"MILD",SEVER=2:"MODERATE",1:"SEVERE") ;21

 .S GMRASP(2)=49,GMRAHDR(2)="OBS D/T: ",GMRALIN(2)=$$FMTE^XLFDT($P(^GMR(120.85,$O(^GMR(120.85,"C",GMRAPA,0)),0),U)) ;21

 .D WRITE^GMRADSP3 G:GMRAOUT EXIT ;21

 .Q  ;21

 I ($Y+4)>IOSL D EOP^GMRADSP3 G:GMRAOUT EXIT

 D DISP1^GMRAPEM1(GMRAPA,"O",.GMRAOUT) G:GMRAOUT EXIT

 S (GMRASP(1),GMRASP(2))="" D WRITE^GMRADSP3 G:GMRAOUT EXIT

 S GMRASP(1)=0,GMRAHDR(1)="ID BAND MARKED: ",Y="",Y=$O(^GMR(120.8,GMRAPA,14,"A",Y)),Y=9999999-Y S:Y'=9999999 Y=$$FMTE^XLFDT(Y) S:Y=9999999 Y="" ;21

 S GMRASP(2)=44,GMRALIN(1)=Y,GMRAHDR(2)="CHART MARKED: ",Y="",Y=$O(^GMR(120.8,GMRAPA,13,"A",Y)),Y=9999999-Y S:Y'=9999999 Y=$$FMTE^XLFDT(Y) S:Y=9999999 Y="" S GMRALIN(2)=Y ;21

 D WRITE^GMRADSP3 G:GMRAOUT EXIT

 ;IHS/MSC/MGH mods returned patch 1006

 I $D(GMRAIN)>0 D

 .S (GMRASP(1),GMRASP(2))="" D WRITE^GMRADSP3 G:GMRAOUT EXIT

 .N X,X2,X3,X4,X5,Z,IIEN

 .S Z=9999999 S Z=$O(^GMR(120.8,GMRAPA,9999999.12,Z),-1) I +Z D

 ..S IIEN=Z_","_GMRAPA_","

 ..S X=$$GET1^DIQ(120.899999912,IIEN,.01),X2=$$GET1^DIQ(120.899999912,IIEN,1),X3=$$GET1^DIQ(120.899999912,IIEN,2)

 ..S X4=$$GET1^DIQ(120.899999912,IIEN,3),X5=$$GET1^DIQ(120.899999912,IIEN,4)

 ..S GMRASP(1)=0,GMRAHDR(1)="INACTIVE: ",GMRALIN(1)=X

 ..D WRITE^GMRADSP3 G:GMRAOUT EXIT

 ..S GMRASP(1)=6,GMRAHDR(1)="REASON: ",GMRALIN(1)=X2

 ..S GMRASP(2)=40,GMRAHDR(2)="BY: ",GMRALIN(2)=X3

 ..D WRITE^GMRADSP3 G:GMRAOUT EXIT

 ..I X4'="" D

 ...S GMRASP(1)=0,GMRAHDR(1)="REACTIVATION: ",GMRALIN(1)=X4

 ...S GMRASP(2)=30,GMRAHDR(2)="BY: ",GMRALIN(2)=X5

 ...D WRITE^GMRADSP3 G:GMRAOUT EXIT

 G RESET

LINEOUT ;

 S GMRASP(1)=$S(GMRAFT:6,1:16),GMRAHDR(1)=$S(GMRAFT:"COMMENTS: ",1:""),GMRALIN(1)=$S($D(^UTILITY($J,"W",15,+GMRAX,0)):^(0),1:""),GMRASP(2)="" D WRITE^GMRADSP3 G:GMRAOUT EXIT S GMRAFT=0

 Q

RESET ;

 D ^GMRADSP3

EXIT K DIWF,DIWL,DIWR,GMRA,GMRADC,GMRADI,GMRAHDR,GMRSN0,GMRALIN,GMRASP,GMRAFT,GMRAREA,GMRATRT,GMRAX,SNOTXT,SNOCODE

 Q

GMRADSP2  ;HIRMFO/RM,WAA-PRINT PATIENT A/AR ;01-May-2012 14:15;DU

 +1       ;;4.0;Adverse Reaction Tracking;**21,1002,1006**;Mar 29, 1996;Build 29

 +2       ;IHS/MSC/MGH  added data for source patch 1002,1006

EN1       ; ENTRY TO PRINT DATA FOR A SINGLE RECORD DENOTED BY GMRAPA

 +1        SET GMRAOUT=0

 +2        SET GMRAPA(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")

 +3       ;IHS/MSC/MGH added back patch 1006

 +4        SET GMRAPA(9999999.11)=$SELECT($DATA(^GMR(120.8,GMRAPA,9999999.11)):^(9999999.11),1:"")

 +5        SET DFN=$PIECE(GMRAPA(0),"^")

           DO DEM^VADPT

           SET GMRANAM=VADM(1)

           DO KVAR^VADPT

           KILL VA

 +6        SET GMRADRUG=$SELECT($PIECE(GMRAPA(0),U,20)["D":1,1:0)

 +7        SET GMRAERR=$SELECT($DATA(^GMR(120.8,GMRAPA,"ER")):+^("ER"),1:0)

           IF '$DATA(GMRAPG)

               SET GMRAPG=0

 +8        IF $Y+3>IOSL

               DO EOP^GMRADSP3

           IF GMRAOUT

               GOTO EXIT

 +9       ;D:'GMRAPG HDR^GMRADSP3

 +10      ;21

           IF 'GMRAPRNT

               SET GMRASP(1)=7

               SET GMRAHDR(1)="PATIENT: "

               SET GMRALIN(1)=$EXTRACT(GMRANAM,1,23)

               SET GMRASP(2)=41

               SET GMRAHDR(2)="CAUSATIVE AGENT: "

               SET GMRALIN(2)=$EXTRACT($PIECE(GMRAPA(0),"^",2),1,21)

               DO WRITE^GMRADSP3

               IF GMRAOUT

                   GOTO EXIT

 +11       IF GMRAPRNT

               SET GMRASP(1)=9

               SET GMRAHDR(1)="AGENT: "

               SET GMRALIN(1)=$EXTRACT($PIECE(GMRAPA(0),"^",2),1,23)

               SET GMRASP(2)=""

               DO WRITE^GMRADSP3

               IF GMRAOUT

                   GOTO EXIT

 +12       IF 'GMRADRUG

               GOTO ORIG

           SET (GMRADI,GMRADC)=0

           SET GMRAFT=1

DICL      ;

 +1        IF GMRADI'=""

               SET GMRADI=$ORDER(^GMR(120.8,GMRAPA,2,GMRADI))

           IF GMRADC'=""

               SET GMRADC=$ORDER(^GMR(120.8,GMRAPA,3,GMRADC))

           IF GMRADI'>0&(GMRADC'>0)&'GMRAFT

               GOTO ORIG

 +2        SET GMRASP(1)=$SELECT(GMRAFT:3,'GMRADI:"",1:16)

           SET GMRAHDR(1)=$SELECT(GMRAFT:"INGREDIENTS: ",1:"")

           SET X=$SELECT($DATA(^GMR(120.8,GMRAPA,2,+GMRADI,0)):^(0),1:"")

           SET GMRALIN(1)=$EXTRACT($SELECT($DATA(^PS(50.416,+X,0)):$PIECE(^(0),"^"),1:""),1,23)

 +3        SET GMRASP(2)=$SELECT(GMRAFT:41,'GMRADC:"",1:58)

           SET GMRAHDR(2)=$SELECT(GMRAFT:"VA DRUG CLASSES: ",1:"")

           SET X=$SELECT($DATA(^GMR(120.8,GMRAPA,3,+GMRADC,0)):^(0),1:"")

           SET GMRALIN(2)=$EXTRACT($SELECT($DATA(^PS(50.605,+X,0)):$PIECE(^(0),"^",2),1:""),1,21)

 +4        DO WRITE^GMRADSP3

           IF GMRAOUT

               GOTO EXIT

           SET GMRAFT=0

           GOTO DICL

ORIG      ;

 +1        SET GMRAREA=0

           SET GMRATRT=0

 +2        SET (GMRASP(1),GMRASP(2))=""

           DO WRITE^GMRADSP3

           IF GMRAOUT

               GOTO EXIT

 +3       ;IHS/MSC/MGH added back patch 1006

 +4        IF $PIECE($GET(^GMR(120.8,GMRAPA,9999999.11)),U,1)'=""

               Begin DoDot:1

 +5                SET GMRASP(1)=6

                   SET GMRAHDR(1)="SOURCE OF INFORMATION: "

                   SET GMRALIN(1)=$$GET1^DIQ(120.8,GMRAPA,9999999.11)

 +6                DO WRITE^GMRADSP3

                   IF GMRAOUT

                       GOTO EXIT

               End DoDot:1

 +7       ;end mod

 +8       ;21

           SET Y=$PIECE(GMRAPA(0),"^",4)

           IF Y

               SET Y=$$FMTE^XLFDT(Y)

           SET GMRASP(1)=4

           SET GMRAHDR(1)="ORIGINATOR: "

           SET GMRALIN(1)=$$GET1^DIQ(200,$PIECE(GMRAPA(0),U,5)_",",".01")

 +9        SET GMRASP(2)=46

           SET GMRAHDR(2)="ORIGINATED: "

           SET GMRALIN(2)=Y

           DO WRITE^GMRADSP3

           IF GMRAOUT

               GOTO EXIT

 +10       SET GMRASP(1)=6

           SET GMRAHDR(1)="SIGN OFF: "

           SET GMRALIN(1)=$SELECT($PIECE(GMRAPA(0),"^",12)=1:"YES",1:"NO")

           SET GMRASP(2)=48

           SET GMRAHDR(2)="OBS/HIST: "

           SET GMRALIN(2)=$SELECT($PIECE(GMRAPA(0),"^",6)="o":"OBSERVED",$PIECE(GMRAPA(0),"^",6)="h":"HISTORICAL",1:"")

 +11       DO WRITE^GMRADSP3

           IF GMRAOUT

               GOTO EXIT

 +12      ;IHS/MSC/MGH Mod added back patch 1006

 +13      ;Printout the SNOMED event IHS/MSC/MGH

 +14       SET GMRSNO=$PIECE(GMRAPA(9999999.11),"^",2)

 +15       IF +GMRSNO

               Begin DoDot:1

 +16               SET SNOTXT=$PIECE($GET(^BEHOAR(90460.06,GMRSNO,0)),U,1)

                   SET SNOCODE=$PIECE($GET(^BEHOAR(90460.06,GMRSNO,0)),U,2)

 +17               SET GMRASP(1)=6

                   SET GMRAHDR(1)="EVENT: "

                   SET GMRALIN(1)=SNOTXT

 +18               SET GNRASP(2)=46

                   SET GMRAHDR(2)="CODE: "

                   SET GMRALIN(2)=SNOCODE

                   DO WRITE^GMRADSP3

 +19               IF GMRAOUT

                       GOTO EXIT

 +20      ;end mod

               End DoDot:1

 +21      ;21

           IF $DATA(^GMR(120.85,"C",GMRAPA))

               Begin DoDot:1

 +22      ;21

                   SET (GMRASP(1),GMRASP(2))=""

 +23      ;21

                   NEW GMRAI,SEVER

                   SET (GMRAI,SEVER)=0

                   FOR 

                       SET GMRAI=$ORDER(^GMR(120.85,"C",GMRAPA,GMRAI))

                       IF '+GMRAI

                           QUIT 

                       IF +$PIECE(^GMR(120.85,GMRAI,0),U,14)>SEVER

                           SET SEVER=$PIECE(^(0),U,14)

 +24      ;21

                   IF $GET(SEVER)

                       SET GMRASP(1)=6

                       SET GMRAHDR(1)="SEVERITY: "

                       SET GMRALIN(1)=$SELECT(SEVER=1:"MILD",SEVER=2:"MODERATE",1:"SEVERE")

 +25      ;21

                   SET GMRASP(2)=49

                   SET GMRAHDR(2)="OBS D/T: "

                   SET GMRALIN(2)=$$FMTE^XLFDT($PIECE(^GMR(120.85,$ORDER(^GMR(120.85,"C",GMRAPA,0)),0),U))

 +26      ;21

                   DO WRITE^GMRADSP3

                   IF GMRAOUT

                       GOTO EXIT

 +27      ;21

                   QUIT 

               End DoDot:1

 +28       IF ($Y+4)>IOSL

               DO EOP^GMRADSP3

               IF GMRAOUT

                   GOTO EXIT

 +29       DO DISP1^GMRAPEM1(GMRAPA,"O",.GMRAOUT)

           IF GMRAOUT

               GOTO EXIT

 +30       SET (GMRASP(1),GMRASP(2))=""

           DO WRITE^GMRADSP3

           IF GMRAOUT

               GOTO EXIT

 +31      ;21

           SET GMRASP(1)=0

           SET GMRAHDR(1)="ID BAND MARKED: "

           SET Y=""

           SET Y=$ORDER(^GMR(120.8,GMRAPA,14,"A",Y))

           SET Y=9999999-Y

           IF Y'=9999999

               SET Y=$$FMTE^XLFDT(Y)

           IF Y=9999999

               SET Y=""

 +32      ;21

           SET GMRASP(2)=44

           SET GMRALIN(1)=Y

           SET GMRAHDR(2)="CHART MARKED: "

           SET Y=""

           SET Y=$ORDER(^GMR(120.8,GMRAPA,13,"A",Y))

           SET Y=9999999-Y

           IF Y'=9999999

               SET Y=$$FMTE^XLFDT(Y)

           IF Y=9999999

               SET Y=""

           SET GMRALIN(2)=Y

 +33       DO WRITE^GMRADSP3

           IF GMRAOUT

               GOTO EXIT

 +34      ;IHS/MSC/MGH mods returned patch 1006

 +35       IF $DATA(GMRAIN)>0

               Begin DoDot:1

 +36               SET (GMRASP(1),GMRASP(2))=""

                   DO WRITE^GMRADSP3

                   IF GMRAOUT

                       GOTO EXIT

 +37               NEW X,X2,X3,X4,X5,Z,IIEN

 +38               SET Z=9999999

                   SET Z=$ORDER(^GMR(120.8,GMRAPA,9999999.12,Z),-1)

                   IF +Z

                       Begin DoDot:2

 +39                       SET IIEN=Z_","_GMRAPA_","

 +40                       SET X=$$GET1^DIQ(120.899999912,IIEN,.01)

                           SET X2=$$GET1^DIQ(120.899999912,IIEN,1)

                           SET X3=$$GET1^DIQ(120.899999912,IIEN,2)

 +41                       SET X4=$$GET1^DIQ(120.899999912,IIEN,3)

                           SET X5=$$GET1^DIQ(120.899999912,IIEN,4)

 +42                       SET GMRASP(1)=0

                           SET GMRAHDR(1)="INACTIVE: "

                           SET GMRALIN(1)=X

 +43                       DO WRITE^GMRADSP3

                           IF GMRAOUT

                               GOTO EXIT

 +44                       SET GMRASP(1)=6

                           SET GMRAHDR(1)="REASON: "

                           SET GMRALIN(1)=X2

 +45                       SET GMRASP(2)=40

                           SET GMRAHDR(2)="BY: "

                           SET GMRALIN(2)=X3

 +46                       DO WRITE^GMRADSP3

                           IF GMRAOUT

                               GOTO EXIT

 +47                       IF X4'=""

                               Begin DoDot:3

 +48                               SET GMRASP(1)=0

                                   SET GMRAHDR(1)="REACTIVATION: "

                                   SET GMRALIN(1)=X4

 +49                               SET GMRASP(2)=30

                                   SET GMRAHDR(2)="BY: "

                                   SET GMRALIN(2)=X5

 +50                               DO WRITE^GMRADSP3

                                   IF GMRAOUT

                                       GOTO EXIT

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +51       GOTO RESET

LINEOUT   ;

 +1        SET GMRASP(1)=$SELECT(GMRAFT:6,1:16)

           SET GMRAHDR(1)=$SELECT(GMRAFT:"COMMENTS: ",1:"")

           SET GMRALIN(1)=$SELECT($DATA(^UTILITY($JOB,"W",15,+GMRAX,0)):^(0),1:"")

           SET GMRASP(2)=""

           DO WRITE^GMRADSP3

           IF GMRAOUT

               GOTO EXIT

           SET GMRAFT=0

 +2        QUIT 

RESET     ;

 +1        DO ^GMRADSP3

EXIT       KILL DIWF,DIWL,DIWR,GMRA,GMRADC,GMRADI,GMRAHDR,GMRSN0,GMRALIN,GMRASP,GMRAFT,GMRAREA,GMRATRT,GMRAX,SNOTXT,SNOCODE

 +1        QUIT