- GMRAU851 ;HIRMFO/RFM,WAA-UTILITIES FOR FILE 120.85 ;01-May-2012 14:26;DU
- ;;4.0;Adverse Reaction Tracking;**21,1002,1006**;Mar 29, 1996;Build 29
- HLP ;
- N DIR
- I '$D(^GMR(120.8,"B",DFN)) W !?4,"There are no reactions on file for this patient." Q
- D HLP12085(DFN,"$$OBSDRG^GMRAU85(GMRAX)")
- Q
- HLP12085(DFN,SCR) ; THIS WILL LIST ENTRIES FOR PATIENT (DFN) IN FILE
- ; 120.85. AN OPTIONAL SCREEN (SCR), EXECUTABLE BOOLEAN FXN, WILL BE
- ; USED TO SCREEN OUT ENTRIES, WHILE USING SCREEN, GMRAX WILL BE 120.8
- ; IEN. GMRAOUT WILL BE SET TRUE IF ^/TIME OUT.
- N GMRAL,GMRAX,GMRAY,INAC
- I $G(SCR)="" S SCR="SCR=SCR"
- S GMRAX="" F S GMRAX=$O(^GMR(120.8,"B",DFN,GMRAX)) Q:GMRAX'>0 S GMRAY=$P($G(^GMR(120.8,GMRAX,0)),U,2) I GMRAY]"",@SCR S GMRAL(GMRAY,GMRAX)=""
- W #,!!,"CHOOSE FROM:" S GMRAY="" F Q:GMRAOUT S GMRAY=$O(GMRAL(GMRAY)) Q:GMRAY="" S GMRAX="" F S GMRAX=$O(GMRAL(GMRAY,GMRAX)) Q:GMRAX'>0 D Q:GMRAOUT
- . ;IHS/MSC/MGH check for inactive patch 1006
- . S INAC=$$INACTIVE^GMRADSP6(GMRAX)
- . I INAC=1 S GMRAY=GMRAY_" (Inactive)"
- . I $Y>(IOSL-3) D ENDPG^GMRADSP3 Q:GMRAOUT W #
- . W !?3,GMRAY
- . Q
- Q
- HLP1 ;
- I '$D(^GMR(120.85,"C",GMRAPA)) W !?4,"There are no observed date/times on file for this reaction." Q
- S X="??",DIC="^GMR(120.85,",DIC(0)="EQ",DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,15)=GMRAPA",DIC("W")="" D ^DIC K DIC
- Q
- RXN ;ENTRY TO EDIT THE OBSERVED A/AR DATA
- N GMRAR0 ;21
- S GMRANDT=1
- S GMRAPA=$P($G(^GMR(120.85,GMRAPA1,0)),U,15),GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
- S GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0))
- F GMRAX=0:0 S GMRAX=$O(^GMR(120.85,GMRAPA1,2,GMRAX)) Q:GMRAX'>0 S Y=$S($D(^GMR(120.85,GMRAPA1,2,GMRAX,0)):^(0),1:""),X=$S(+Y=GMRAOTH:$P(Y,"^",2),$D(^GMRD(120.83,+Y,0)):$P(^(0),"^"),1:"") I X'="",Y'="" S GMRARPR(X,+Y)=X_"^"_$P(Y,"^",3)
- D SITE^GMRAUTL
- S GMRAY=GMRASITE
- I GMRAY>0 F GMRAX=1:1:10 S X=$S($D(^GMRD(120.84,GMRAY,1,GMRAX,0)):$P(^(0),"^"),1:""),Y=$S($D(^GMRD(120.83,+X,0)):^(0),1:""),GMRAR10(GMRAX)=$S(X'=""!(Y'=""):X_"^"_Y,1:"")
- D EN1^GMRAPER0 Q:GMRAOUT S:'$D(^GMR(120.85,GMRAPA1,2,0)) ^(0)="^120.8502P^^" S:'$D(^GMR(120.8,GMRAPA,10,0)) ^(0)="^120.81P^^" ;21
- F GMRAREC=0:0 S GMRAREC=$O(GMRARAD(GMRAREC)) Q:GMRAREC'>0 S GMRAR0=GMRAREC_"^^"_DUZ D ADREAC ;21
- S GMRAREC="" F GMRAX=0:0 S GMRAREC=$O(GMRAROT(GMRAREC)) Q:GMRAREC="" S GMRAR0=GMRAOTH_"^"_GMRAREC_"^"_DUZ D ADREAC ;21
- F GMRAREC=0:0 S GMRAREC=$O(GMRARDL(GMRAREC)) Q:GMRAREC'>0 D DELREAC ;21
- S GMRAREC="" F GMRAX=0:0 S GMRAREC=$O(GMRAROTD(GMRAREC)) Q:GMRAREC="" D DELREACO ;21
- Q
- ADREAC ; ADD ENTRY TO SIGNS/SYMPTOMS MULTIPLE
- S GMRAZN=$P(^GMR(120.85,GMRAPA1,2,0),"^",3,4),DA=$P(GMRAZN,"^")+1 F DA=DA:1 Q:'$D(^GMR(120.85,GMRAPA1,2,DA,0))
- S ^GMR(120.85,GMRAPA1,2,DA,0)=GMRAR0 S DIK="^GMR(120.85,DA(1),2,",DA(1)=GMRAPA1 D IX1^DIK S $P(^GMR(120.85,GMRAPA1,2,0),"^",3,4)=DA_"^"_($P(GMRAZN,"^",2)+1)
- S GMRAZN=$P(^GMR(120.8,GMRAPA,10,0),"^",3,4),DA=$P(GMRAZN,"^")+1 F DA=DA:1 Q:'$D(^GMR(120.8,GMRAPA,10,DA,0)) ;21
- S ^GMR(120.8,GMRAPA,10,DA,0)=GMRAR0_"^"_DT S DIK="^GMR(120.8,DA(1),10,",DA(1)=GMRAPA D IX1^DIK S $P(^GMR(120.8,GMRAPA,10,0),"^",3,4)=DA_"^"_($P(GMRAZN,"^",2)+1) ;21
- Q
- ;
- DELREAC ;Delete reactions from 120.85 and 120.8 entire section added in patch 21
- S DA(1)=GMRAPA1,DIK="^GMR(120.85,"_DA(1)_",2,"
- F DA=0:0 S DA=$O(^GMR(120.85,DA(1),2,"B",GMRAREC,DA)) Q:DA'>0 D ^DIK
- S DA(1)=GMRAPA,DIK="^GMR(120.8,"_DA(1)_",10,"
- F DA=0:0 S DA=$O(^GMR(120.8,DA(1),10,"B",GMRAREC,DA)) Q:DA'>0 D ^DIK
- Q
- ;
- DELREACO ;Delete free text reactions, added in 21
- S DA(1)=GMRAPA1,DIK="^GMR(120.85,"_DA(1)_",2,"
- F DA=0:0 S DA=$O(^GMR(120.85,DA(1),2,"B",GMRAOTH,DA)) Q:DA'>0 I $D(^GMR(120.85,DA(1),2,DA,0)),$P(^(0),U,2)=GMRAREC D ^DIK
- S DA(1)=GMRAPA,DIK="^GMR(120.8,"_DA(1)_",10,"
- F DA=0:0 S DA=$O(^GMR(120.8,DA(1),10,"B",GMRAOTH,DA)) Q:DA'>0 I $D(^GMR(120.8,DA(1),10,DA,0)),$P(^(0),U,2)=GMRAREC D ^DIK
- Q
- GMRAU851 ;HIRMFO/RFM,WAA-UTILITIES FOR FILE 120.85 ;01-May-2012 14:26;DU
- +1 ;;4.0;Adverse Reaction Tracking;**21,1002,1006**;Mar 29, 1996;Build 29
- HLP ;
- +1 NEW DIR
- +2 IF '$DATA(^GMR(120.8,"B",DFN))
- WRITE !?4,"There are no reactions on file for this patient."
- QUIT
- +3 DO HLP12085(DFN,"$$OBSDRG^GMRAU85(GMRAX)")
- +4 QUIT
- HLP12085(DFN,SCR) ; THIS WILL LIST ENTRIES FOR PATIENT (DFN) IN FILE
- +1 ; 120.85. AN OPTIONAL SCREEN (SCR), EXECUTABLE BOOLEAN FXN, WILL BE
- +2 ; USED TO SCREEN OUT ENTRIES, WHILE USING SCREEN, GMRAX WILL BE 120.8
- +3 ; IEN. GMRAOUT WILL BE SET TRUE IF ^/TIME OUT.
- +4 NEW GMRAL,GMRAX,GMRAY,INAC
- +5 IF $GET(SCR)=""
- SET SCR="SCR=SCR"
- +6 SET GMRAX=""
- FOR
- SET GMRAX=$ORDER(^GMR(120.8,"B",DFN,GMRAX))
- IF GMRAX'>0
- QUIT
- SET GMRAY=$PIECE($GET(^GMR(120.8,GMRAX,0)),U,2)
- IF GMRAY]""
- IF @SCR
- SET GMRAL(GMRAY,GMRAX)=""
- +7 WRITE #,!!,"CHOOSE FROM:"
- SET GMRAY=""
- FOR
- IF GMRAOUT
- QUIT
- SET GMRAY=$ORDER(GMRAL(GMRAY))
- IF GMRAY=""
- QUIT
- SET GMRAX=""
- FOR
- SET GMRAX=$ORDER(GMRAL(GMRAY,GMRAX))
- IF GMRAX'>0
- QUIT
- Begin DoDot:1
- +8 ;IHS/MSC/MGH check for inactive patch 1006
- +9 SET INAC=$$INACTIVE^GMRADSP6(GMRAX)
- +10 IF INAC=1
- SET GMRAY=GMRAY_" (Inactive)"
- +11 IF $Y>(IOSL-3)
- DO ENDPG^GMRADSP3
- IF GMRAOUT
- QUIT
- WRITE #
- +12 WRITE !?3,GMRAY
- +13 QUIT
- End DoDot:1
- IF GMRAOUT
- QUIT
- +14 QUIT
- HLP1 ;
- +1 IF '$DATA(^GMR(120.85,"C",GMRAPA))
- WRITE !?4,"There are no observed date/times on file for this reaction."
- QUIT
- +2 SET X="??"
- SET DIC="^GMR(120.85,"
- SET DIC(0)="EQ"
- SET DIC("S")="I $P(^(0),U,2)=DFN,$P(^(0),U,15)=GMRAPA"
- SET DIC("W")=""
- DO ^DIC
- KILL DIC
- +3 QUIT
- RXN ;ENTRY TO EDIT THE OBSERVED A/AR DATA
- +1 ;21
- NEW GMRAR0
- +2 SET GMRANDT=1
- +3 SET GMRAPA=$PIECE($GET(^GMR(120.85,GMRAPA1,0)),U,15)
- SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
- +4 SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
- +5 FOR GMRAX=0:0
- SET GMRAX=$ORDER(^GMR(120.85,GMRAPA1,2,GMRAX))
- IF GMRAX'>0
- QUIT
- SET Y=$SELECT($DATA(^GMR(120.85,GMRAPA1,2,GMRAX,0)):^(0),1:"")
- SET X=$SELECT(+Y=GMRAOTH:$PIECE(Y,"^",2),$DATA(^GMRD(120.83,+Y,0)):$PIECE(^(0),"^"),1:"")
- IF X'=""
- IF Y'=""
- SET GMRARPR(X,+Y)=X_"^"_$PIECE(Y,"^",3)
- +6 DO SITE^GMRAUTL
- +7 SET GMRAY=GMRASITE
- +8 IF GMRAY>0
- FOR GMRAX=1:1:10
- SET X=$SELECT($DATA(^GMRD(120.84,GMRAY,1,GMRAX,0)):$PIECE(^(0),"^"),1:"")
- SET Y=$SELECT($DATA(^GMRD(120.83,+X,0)):^(0),1:"")
- SET GMRAR10(GMRAX)=$SELECT(X'=""!(Y'=""):X_"^"_Y,1:"")
- +9 ;21
- DO EN1^GMRAPER0
- IF GMRAOUT
- QUIT
- IF '$DATA(^GMR(120.85,GMRAPA1,2,0))
- SET ^(0)="^120.8502P^^"
- IF '$DATA(^GMR(120.8,GMRAPA,10,0))
- SET ^(0)="^120.81P^^"
- +10 ;21
- FOR GMRAREC=0:0
- SET GMRAREC=$ORDER(GMRARAD(GMRAREC))
- IF GMRAREC'>0
- QUIT
- SET GMRAR0=GMRAREC_"^^"_DUZ
- DO ADREAC
- +11 ;21
- SET GMRAREC=""
- FOR GMRAX=0:0
- SET GMRAREC=$ORDER(GMRAROT(GMRAREC))
- IF GMRAREC=""
- QUIT
- SET GMRAR0=GMRAOTH_"^"_GMRAREC_"^"_DUZ
- DO ADREAC
- +12 ;21
- FOR GMRAREC=0:0
- SET GMRAREC=$ORDER(GMRARDL(GMRAREC))
- IF GMRAREC'>0
- QUIT
- DO DELREAC
- +13 ;21
- SET GMRAREC=""
- FOR GMRAX=0:0
- SET GMRAREC=$ORDER(GMRAROTD(GMRAREC))
- IF GMRAREC=""
- QUIT
- DO DELREACO
- +14 QUIT
- ADREAC ; ADD ENTRY TO SIGNS/SYMPTOMS MULTIPLE
- +1 SET GMRAZN=$PIECE(^GMR(120.85,GMRAPA1,2,0),"^",3,4)
- SET DA=$PIECE(GMRAZN,"^")+1
- FOR DA=DA:1
- IF '$DATA(^GMR(120.85,GMRAPA1,2,DA,0))
- QUIT
- +2 SET ^GMR(120.85,GMRAPA1,2,DA,0)=GMRAR0
- SET DIK="^GMR(120.85,DA(1),2,"
- SET DA(1)=GMRAPA1
- DO IX1^DIK
- SET $PIECE(^GMR(120.85,GMRAPA1,2,0),"^",3,4)=DA_"^"_($PIECE(GMRAZN,"^",2)+1)
- +3 ;21
- SET GMRAZN=$PIECE(^GMR(120.8,GMRAPA,10,0),"^",3,4)
- SET DA=$PIECE(GMRAZN,"^")+1
- FOR DA=DA:1
- IF '$DATA(^GMR(120.8,GMRAPA,10,DA,0))
- QUIT
- +4 ;21
- SET ^GMR(120.8,GMRAPA,10,DA,0)=GMRAR0_"^"_DT
- SET DIK="^GMR(120.8,DA(1),10,"
- SET DA(1)=GMRAPA
- DO IX1^DIK
- SET $PIECE(^GMR(120.8,GMRAPA,10,0),"^",3,4)=DA_"^"_($PIECE(GMRAZN,"^",2)+1)
- +5 QUIT
- +6 ;
- DELREAC ;Delete reactions from 120.85 and 120.8 entire section added in patch 21
- +1 SET DA(1)=GMRAPA1
- SET DIK="^GMR(120.85,"_DA(1)_",2,"
- +2 FOR DA=0:0
- SET DA=$ORDER(^GMR(120.85,DA(1),2,"B",GMRAREC,DA))
- IF DA'>0
- QUIT
- DO ^DIK
- +3 SET DA(1)=GMRAPA
- SET DIK="^GMR(120.8,"_DA(1)_",10,"
- +4 FOR DA=0:0
- SET DA=$ORDER(^GMR(120.8,DA(1),10,"B",GMRAREC,DA))
- IF DA'>0
- QUIT
- DO ^DIK
- +5 QUIT
- +6 ;
- DELREACO ;Delete free text reactions, added in 21
- +1 SET DA(1)=GMRAPA1
- SET DIK="^GMR(120.85,"_DA(1)_",2,"
- +2 FOR DA=0:0
- SET DA=$ORDER(^GMR(120.85,DA(1),2,"B",GMRAOTH,DA))
- IF DA'>0
- QUIT
- IF $DATA(^GMR(120.85,DA(1),2,DA,0))
- IF $PIECE(^(0),U,2)=GMRAREC
- DO ^DIK
- +3 SET DA(1)=GMRAPA
- SET DIK="^GMR(120.8,"_DA(1)_",10,"
- +4 FOR DA=0:0
- SET DA=$ORDER(^GMR(120.8,DA(1),10,"B",GMRAOTH,DA))
- IF DA'>0
- QUIT
- IF $DATA(^GMR(120.8,DA(1),10,DA,0))
- IF $PIECE(^(0),U,2)=GMRAREC
- DO ^DIK
- +5 QUIT