- GMTSALG ; SLC/DLT,KER - Allergies ;08-Mar-2011 08:39;DU
- ;;2.7;Health Summary;**9,28,49,58,1004**;Oct 20, 1995;Build 9
- ;
- ; External References
- ; DBIA 10096 ^%ZOSF("TEST"
- ; DBIA 10035 ^DPT(
- ; DBIA 905 ^GMR(120.8
- ; DBIA 2056 $$GET1^DIQ (file #120.86 and #200)
- ; DBIA 10011 ^DIWP
- ; DBIA 10099 EN1^GMRADPT
- ; DBIA 10060 ^VA(200,
- ; DBIA 3449 ^GMR(120.86,
- ;
- ALLRG ; Allergies
- N X,GMTSALAS,GMTSALAD,GMTSALAW,GMTSALAT,GMTSAV,GMTSAFN,GMRAL,GMTSAL,GMRAUNDT,GMRAUNRE
- N GMTSALNM,GMRSRC,GMTSSRC,GMTSSTM,GMTSCNT,GMTSEACT,GMTSLN,GMTSMECH,GMTSPRT,GMTSTY,CC,C,KK,INACTIVE
- N ALLRG,TITLE,JJ K GMTSA S (SEQ,ALLRG)=0,TITLE="ALLERGY/ADVERSE REACTION (AR)"
- S X="GMRADPT" X ^%ZOSF("TEST")
- I $T D Q:$D(GMTSQIT)
- . D GETALLRG D:ALLRG TITLE,ALLRGP D:'ALLRG&($L($G(GMTSALAS))) TITLE,NKA
- I 'ALLRG,'$L($G(GMTSALAS)) D
- . D PRUN
- . I $D(GMTSPNF)&('ALLRG) D CKP^GMTSUP Q:$D(GMTSQIT) W "Unknown, please evaluate",!
- K ALL,CC,CCC,CD,DIWF,DIWL,DIWR,GMTSALF,GMTSALNM,GMTSNODE,GMTSPRT,I,II,JJ,KK,L,M,MX,N,Z,X,SEQ,GMTSA,ALLRG,TITLE,GMRA,GMRAL,GMTSEACT,GMTSMECH,GMTSTY,GMTSPFN,GMTSAL,GMTSCNT,GMTSLN,ODT
- Q
- ALLRGP ; Allergy Print
- I GMRAUNDT'="" D PRUN
- S II="" F S II=$O(GMTSAL(II)) Q:II']"" I $O(GMTSAL(II,""))]"" D
- . D CKP^GMTSUP Q:$D(GMTSQIT) W !?2,$S(II="D":"Drug:",II="DF":"Drug/Food:",II="DFO":"Drug/Food/Other:",II="DO":"Drug/Other:",II="F":"Food:",II="FO":"Food/Other:",II="O":"Other:",1:II_":")
- . S JJ="" F S JJ=$O(GMTSAL(II,JJ)) Q:JJ="" D
- ..N WKK S KK="" F S KK=$O(GMTSAL(II,JJ,KK)) Q:KK="" D
- ...S L=0 F S L=$O(GMTSAL(II,JJ,KK,L)) Q:'L D CKP^GMTSUP Q:$D(GMTSQIT) D AUTOV W !?5,JJ_": " S:$L(KK)>30 WKK=KK,WKK=$$WRAP^GMTSORC(WKK,30) W ?24,$S($L(KK)>30:$P(WKK,"|"),1:KK) D
- ....I GMTSAV=1 W " (AV"
- ....E W $S($P(GMTSAL(II,JJ,KK,L),U,5)=1:" (V",$P(GMTSAL(II,JJ,KK,L),U,5)=0:" (NV",1:"")
- ....W $S($P($G(^GMR(120.8,GMTSALNM,0)),U,6)="h":"/Historical)",$P($G(^(0)),U,6)="o":"/Observed)",1:")")
- ....I $L($P($G(WKK),"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W !,?24,$P(WKK,"|",2)
- ....;IHS/MSC/MGH source added
- ....I $P(GMTSAL(II,JJ,KK,L),U,11)'="" D
- .....S GMTSRC=$P(GMTSAL(II,JJ,KK,L),U,11) S GMTSRC=$P($G(^BEHOAR(90460.05,GMTSRC,0)),U,1)
- .....W !,?24,"Source: "_GMTSRC
- ....S (M,MX,ALL)=0 F S M=$O(GMTSAL(II,JJ,KK,L,"S",M)) Q:M="" D Q:$D(GMTSQIT)
- .....I ALL=0 D CKP^GMTSUP Q:$D(GMTSQIT) W !?27
- .....S MX=MX+1
- .....W:MX>1 ", "
- .....S N=$P(GMTSAL(II,JJ,KK,L,"S",M),";")
- .....S ALL=1 I (74)'>($X+$L(N)) D CKP^GMTSUP Q:$D(GMTSQIT) W !,?27,N Q
- .....S ALL=1 W N
- .....;IHS/MSC/MGH source of reaction added
- .....I $P($G(GMTSAL(II,JJ,KK,L,"S",M)),U,3)'="" D
- ......S GMTSSRC=$P($G(GMTSAL(II,JJ,KK,L,"S",M)),U,3) S GMTSSRC=$P($G(^BEHOAR(90460.05,GMTSSRC,0)),U,1)
- ......S GMTSSTM=$P($G(GMTSAL(II,JJ,KK,L,"S",M)),U,2) S X=GMTSSTM D REGDTM4^GMTSU
- ......D CKP^GMTSUP Q:$D(GMTSQIT) W !,?27,"Date Noted: "_X
- ......D CKP^GMTSUP Q:$D(GMTSQIT) W !,?27,"Reaction Source: "_GMTSSRC
- ....D SIGBLK($P(GMTSAFN,U,5))
- ....D CKP^GMTSUP Q:$D(GMTSQIT) W !,?24,"Date/Time: " S ODT=$P(GMTSAFN,U,4) S X=ODT D REGDTM4^GMTSU W X,!
- ....S CC="" F S CC=$O(^GMR(120.8,GMTSALNM,26,"B",CC)) Q:CC="" D CKP^GMTSUP Q:$D(GMTSQIT) W !,?24,"Comments at: " S X=CC D REGDTM4^GMTSU S CD=X S CCC=0 F S CCC=$O(^GMR(120.8,GMTSALNM,26,"B",CC,CCC)) Q:'CCC D TEXT
- Q
- NKA ; No known allergies
- I GMRAUNDT'="" D PRUN
- D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMTSALAS))!($L($G(GMTSALAD))) !
- D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMTSALAS)) ?22,$G(GMTSALAS),!
- D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMTSALAS))!($L($G(GMTSALAD)))!($L($G(GMTSALAW))) ?24,"Assessment date: ",$G(GMTSALAD),!
- D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMTSALAW)) ?28,"Assessed by: ",GMTSALAW,!
- D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMTSALAW))&($L($G(GMTSALAT))) ?34,"Title: ",GMTSALAT,!
- Q
- PRUN ;IHS/MSC/MGH Print unassessable
- D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMRAUNDT)) !,?1,"Unassessable Date: ",GMRAUNDT
- D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMRAUNRE)) ?50,"Reason ",GMRAUNRE
- Q
- GETALLRG ; Get Allergies
- D UNASS(DFN)
- S GMRA="0^0^111" D EN1^GMRADPT I GMRAL="" S ALLRG=0 Q
- I +($G(DFN))>0,+($G(GMRAL))=0 D ALLAS S ALLRG=0 Q
- I $D(GMRAL)>9 D
- . S I=0 F GMTSCNT=1:1 S I=$O(GMRAL(I)) Q:'I D
- .. S GMTSTY=$P(GMRAL(I),U,7) Q:GMTSTY']""
- .. S GMTSEACT=$P(GMRAL(I),U,2) Q:GMTSEACT']""
- .. S GMTSMECH=$P($P(GMRAL(I),U,8),";")
- .. S:GMTSMECH']"" GMTSMECH="UNKNOWN"
- .. S GMTSAL(GMTSTY,GMTSMECH,GMTSEACT,GMTSCNT)=I_"^"_GMRAL(I)
- .. S GMTSRC=$P(GMRAL(I),U,10)
- .. S JJ=0 F S JJ=$O(GMRAL(I,"S",JJ)) Q:'JJ S GMTSAL(GMTSTY,GMTSMECH,GMTSEACT,GMTSCNT,"S",JJ)=GMRAL(I,"S",JJ)
- .. S ALLRG=1
- Q
- ALLAS ; Allergy Assessment
- N X,GMTSALG1,GMTSALG2,GMTSALG3,GMTSAU S (GMTSALAS,GMTSALAD,GMTSALAW)="" S GMTSALAS="No known allergies"
- S GMTSALAD=$$GET1^DIQ(120.86,+($G(DFN)),3,"I",,"GMTSALG2") S:$D(GMTSALG2) GMTSALAD="" S:+GMTSALAD=0 GMTSALAD=""
- I +GMTSALAD>0 S X=GMTSALAD D REGDT4^GMTSU S GMTSALAD=X
- S GMTSAU=$$GET1^DIQ(120.86,+($G(DFN)),2,"I")
- S GMTSALAW=$$GET1^DIQ(200,(+GMTSAU_","),.01,"E",,"GMTSALG3")
- S GMTSALAT=$$GET1^DIQ(200,(+GMTSAU_","),20.3)
- S:$D(GMTSALG3) (GMTSALAW,GMTSALAT)=""
- Q
- AUTOV ; Autoverify
- S GMTSAV=0,GMTSALNM=$P(GMTSAL(II,JJ,KK,L),U),GMTSAFN=$G(^GMR(120.8,GMTSALNM,0))
- I $P(GMTSAFN,U,18)="",$P(GMTSAFN,U,16)=1 S GMTSAV=1
- Q
- TITLE ; Print title
- D CKP^GMTSUP Q:$D(GMTSQIT)
- I $D(GMTSPNF) W ?21,TITLE,!
- E W ?21,"Title: ",TITLE,!
- Q
- TEXT ; Setup for print of allergy comments
- W ?31,CD D CKP^GMTSUP Q:$D(GMTSQIT)
- K ^UTILITY($J,"W") S GMTSLN=0 F S GMTSLN=$O(^GMR(120.8,GMTSALNM,26,CCC,2,GMTSLN)) Q:'GMTSLN S GMTSPRT=^GMR(120.8,GMTSALNM,26,CCC,2,GMTSLN,0) D FORMAT
- I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",DIWL) D LINE Q:$D(GMTSQIT)
- K ^UTILITY($J,"W")
- Q:'GMTSLN
- W ! Q
- FORMAT ; Formats each line
- S DIWL=3,DIWR=80,DIWF="C58",X=GMTSPRT D ^DIWP
- Q
- LINE ; Writes formatted lines of text
- D CKP^GMTSUP Q:$D(GMTSQIT) W !,?24,^UTILITY($J,"W",DIWL,GMTSLN,0)
- Q
- SIGBLK(GMTSALF) ; Signature block
- Q:+GMTSALF'>0 N GMTSSB,GMTSST,GMTSSN S GMTSSB=$$GET1^DIQ(200,(+GMTSALF_","),20.2),GMTSST=$$GET1^DIQ(200,(+GMTSALF_","),20.3),GMTSSN=$$GET1^DIQ(200,(+GMTSALF_","),.01)
- D CKP^GMTSUP Q:$D(GMTSQIT) W !!,?24,"Originator: ",$S(GMTSSB'="":GMTSSB,1:GMTSSN)
- D CKP^GMTSUP Q:$D(GMTSQIT) W:$L(GMTSST) !,?24,"Title: ",GMTSST
- Q
- INACTIVE(NODE) ;IHS/MSC/MGH Display the inactive data as needed
- N N,MX,ALL
- D CKP^GMTSUP Q:$D(GMTSQIT) W !,?15,"Inactivation: ",$P(NODE,U,1)_"( "_$P(NODE,U,2)_" )"
- D CKP^GMTSUP Q:$D(GMTSQIT) W !,?15,"Reactivation: ",$P(NODE,U,4)
- Q
- UNASS(DFN) ;IHS/MSC/MGH Check if patient is unassessable
- N Y,IIEN,INIEN
- S (GMRAUNDT,GMRAUNRE)=""
- S Y=9999999 S Y=$O(^GMR(120.86,DFN,9999999.11,Y),-1) I +Y D
- .I $P($G(^GMR(120.86,DFN,9999999.11,Y,0)),U,4)="" D
- ..S INIEN=Y_","_DFN
- ..S GMRAUNDT=$$GET1^DIQ(120.869999911,INIEN,.01)
- ..S GMRAUNRE=$$GET1^DIQ(120.869999911,INIEN,1)
- Q
- GMTSALG ; SLC/DLT,KER - Allergies ;08-Mar-2011 08:39;DU
- +1 ;;2.7;Health Summary;**9,28,49,58,1004**;Oct 20, 1995;Build 9
- +2 ;
- +3 ; External References
- +4 ; DBIA 10096 ^%ZOSF("TEST"
- +5 ; DBIA 10035 ^DPT(
- +6 ; DBIA 905 ^GMR(120.8
- +7 ; DBIA 2056 $$GET1^DIQ (file #120.86 and #200)
- +8 ; DBIA 10011 ^DIWP
- +9 ; DBIA 10099 EN1^GMRADPT
- +10 ; DBIA 10060 ^VA(200,
- +11 ; DBIA 3449 ^GMR(120.86,
- +12 ;
- ALLRG ; Allergies
- +1 NEW X,GMTSALAS,GMTSALAD,GMTSALAW,GMTSALAT,GMTSAV,GMTSAFN,GMRAL,GMTSAL,GMRAUNDT,GMRAUNRE
- +2 NEW GMTSALNM,GMRSRC,GMTSSRC,GMTSSTM,GMTSCNT,GMTSEACT,GMTSLN,GMTSMECH,GMTSPRT,GMTSTY,CC,C,KK,INACTIVE
- +3 NEW ALLRG,TITLE,JJ
- KILL GMTSA
- SET (SEQ,ALLRG)=0
- SET TITLE="ALLERGY/ADVERSE REACTION (AR)"
- +4 SET X="GMRADPT"
- XECUTE ^%ZOSF("TEST")
- +5 IF $TEST
- Begin DoDot:1
- +6 DO GETALLRG
- IF ALLRG
- DO TITLE
- DO ALLRGP
- IF 'ALLRG&($LENGTH($GET(GMTSALAS)))
- DO TITLE
- DO NKA
- End DoDot:1
- IF $DATA(GMTSQIT)
- QUIT
- +7 IF 'ALLRG
- IF '$LENGTH($GET(GMTSALAS))
- Begin DoDot:1
- +8 DO PRUN
- +9 IF $DATA(GMTSPNF)&('ALLRG)
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE "Unknown, please evaluate",!
- End DoDot:1
- +10 KILL ALL,CC,CCC,CD,DIWF,DIWL,DIWR,GMTSALF,GMTSALNM,GMTSNODE,GMTSPRT,I,II,JJ,KK,L,M,MX,N,Z,X,SEQ,GMTSA,ALLRG,TITLE,GMRA,GMRAL,GMTSEACT,GMTSMECH,GMTSTY,GMTSPFN,GMTSAL,GMTSCNT,GMTSLN,ODT
- +11 QUIT
- ALLRGP ; Allergy Print
- +1 IF GMRAUNDT'=""
- DO PRUN
- +2 SET II=""
- FOR
- SET II=$ORDER(GMTSAL(II))
- IF II']""
- QUIT
- IF $ORDER(GMTSAL(II,""))]""
- Begin DoDot:1
- +3 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !?2,$SELECT(II="D":"Drug:",II="DF":"Drug/Food:",II="DFO":"Drug/Food/Other:",II="DO":"Drug/Other:",II="F":"Food:",II="FO":"Food/Other:",II="O":"Other:",1:II_":")
- +4 SET JJ=""
- FOR
- SET JJ=$ORDER(GMTSAL(II,JJ))
- IF JJ=""
- QUIT
- Begin DoDot:2
- +5 NEW WKK
- SET KK=""
- FOR
- SET KK=$ORDER(GMTSAL(II,JJ,KK))
- IF KK=""
- QUIT
- Begin DoDot:3
- +6 SET L=0
- FOR
- SET L=$ORDER(GMTSAL(II,JJ,KK,L))
- IF 'L
- QUIT
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- DO AUTOV
- WRITE !?5,JJ_": "
- IF $LENGTH(KK)>30
- SET WKK=KK
- SET WKK=$$WRAP^GMTSORC(WKK,30)
- WRITE ?24,$SELECT($LENGTH(KK)>30:$PIECE(WKK,"|"),1:KK)
- Begin DoDot:4
- +7 IF GMTSAV=1
- WRITE " (AV"
- +8 IF '$TEST
- WRITE $SELECT($PIECE(GMTSAL(II,JJ,KK,L),U,5)=1:" (V",$PIECE(GMTSAL(II,JJ,KK,L),U,5)=0:" (NV",1:"")
- +9 WRITE $SELECT($PIECE($GET(^GMR(120.8,GMTSALNM,0)),U,6)="h":"/Historical)",$PIECE($GET(^(0)),U,6)="o":"/Observed)",1:")")
- +10 IF $LENGTH($PIECE($GET(WKK),"|",2))
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !,?24,$PIECE(WKK,"|",2)
- +11 ;IHS/MSC/MGH source added
- +12 IF $PIECE(GMTSAL(II,JJ,KK,L),U,11)'=""
- Begin DoDot:5
- +13 SET GMTSRC=$PIECE(GMTSAL(II,JJ,KK,L),U,11)
- SET GMTSRC=$PIECE($GET(^BEHOAR(90460.05,GMTSRC,0)),U,1)
- +14 WRITE !,?24,"Source: "_GMTSRC
- End DoDot:5
- +15 SET (M,MX,ALL)=0
- FOR
- SET M=$ORDER(GMTSAL(II,JJ,KK,L,"S",M))
- IF M=""
- QUIT
- Begin DoDot:5
- +16 IF ALL=0
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !?27
- +17 SET MX=MX+1
- +18 IF MX>1
- WRITE ", "
- +19 SET N=$PIECE(GMTSAL(II,JJ,KK,L,"S",M),";")
- +20 SET ALL=1
- IF (74)'>($X+$LENGTH(N))
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !,?27,N
- QUIT
- +21 SET ALL=1
- WRITE N
- +22 ;IHS/MSC/MGH source of reaction added
- +23 IF $PIECE($GET(GMTSAL(II,JJ,KK,L,"S",M)),U,3)'=""
- Begin DoDot:6
- +24 SET GMTSSRC=$PIECE($GET(GMTSAL(II,JJ,KK,L,"S",M)),U,3)
- SET GMTSSRC=$PIECE($GET(^BEHOAR(90460.05,GMTSSRC,0)),U,1)
- +25 SET GMTSSTM=$PIECE($GET(GMTSAL(II,JJ,KK,L,"S",M)),U,2)
- SET X=GMTSSTM
- DO REGDTM4^GMTSU
- +26 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !,?27,"Date Noted: "_X
- +27 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !,?27,"Reaction Source: "_GMTSSRC
- End DoDot:6
- End DoDot:5
- IF $DATA(GMTSQIT)
- QUIT
- +28 DO SIGBLK($PIECE(GMTSAFN,U,5))
- +29 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !,?24,"Date/Time: "
- SET ODT=$PIECE(GMTSAFN,U,4)
- SET X=ODT
- DO REGDTM4^GMTSU
- WRITE X,!
- +30 SET CC=""
- FOR
- SET CC=$ORDER(^GMR(120.8,GMTSALNM,26,"B",CC))
- IF CC=""
- QUIT
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !,?24,"Comments at: "
- SET X=CC
- DO REGDTM4^GMTSU
- SET CD=X
- SET CCC=0
- FOR
- SET CCC=$ORDER(^GMR(120.8,GMTSALNM,26,"B",CC,CCC))
- IF 'CCC
- QUIT
- DO TEXT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +31 QUIT
- NKA ; No known allergies
- +1 IF GMRAUNDT'=""
- DO PRUN
- +2 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF $LENGTH($GET(GMTSALAS))!($LENGTH($GET(GMTSALAD)))
- WRITE !
- +3 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF $LENGTH($GET(GMTSALAS))
- WRITE ?22,$GET(GMTSALAS),!
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF $LENGTH($GET(GMTSALAS))!($LENGTH($GET(GMTSALAD)))!($LENGTH($GET(GMTSALAW)))
- WRITE ?24,"Assessment date: ",$GET(GMTSALAD),!
- +5 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF $LENGTH($GET(GMTSALAW))
- WRITE ?28,"Assessed by: ",GMTSALAW,!
- +6 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF $LENGTH($GET(GMTSALAW))&($LENGTH($GET(GMTSALAT)))
- WRITE ?34,"Title: ",GMTSALAT,!
- +7 QUIT
- PRUN ;IHS/MSC/MGH Print unassessable
- +1 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF $LENGTH($GET(GMRAUNDT))
- WRITE !,?1,"Unassessable Date: ",GMRAUNDT
- +2 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF $LENGTH($GET(GMRAUNRE))
- WRITE ?50,"Reason ",GMRAUNRE
- +3 QUIT
- GETALLRG ; Get Allergies
- +1 DO UNASS(DFN)
- +2 SET GMRA="0^0^111"
- DO EN1^GMRADPT
- IF GMRAL=""
- SET ALLRG=0
- QUIT
- +3 IF +($GET(DFN))>0
- IF +($GET(GMRAL))=0
- DO ALLAS
- SET ALLRG=0
- QUIT
- +4 IF $DATA(GMRAL)>9
- Begin DoDot:1
- +5 SET I=0
- FOR GMTSCNT=1:1
- SET I=$ORDER(GMRAL(I))
- IF 'I
- QUIT
- Begin DoDot:2
- +6 SET GMTSTY=$PIECE(GMRAL(I),U,7)
- IF GMTSTY']""
- QUIT
- +7 SET GMTSEACT=$PIECE(GMRAL(I),U,2)
- IF GMTSEACT']""
- QUIT
- +8 SET GMTSMECH=$PIECE($PIECE(GMRAL(I),U,8),";")
- +9 IF GMTSMECH']""
- SET GMTSMECH="UNKNOWN"
- +10 SET GMTSAL(GMTSTY,GMTSMECH,GMTSEACT,GMTSCNT)=I_"^"_GMRAL(I)
- +11 SET GMTSRC=$PIECE(GMRAL(I),U,10)
- +12 SET JJ=0
- FOR
- SET JJ=$ORDER(GMRAL(I,"S",JJ))
- IF 'JJ
- QUIT
- SET GMTSAL(GMTSTY,GMTSMECH,GMTSEACT,GMTSCNT,"S",JJ)=GMRAL(I,"S",JJ)
- +13 SET ALLRG=1
- End DoDot:2
- End DoDot:1
- +14 QUIT
- ALLAS ; Allergy Assessment
- +1 NEW X,GMTSALG1,GMTSALG2,GMTSALG3,GMTSAU
- SET (GMTSALAS,GMTSALAD,GMTSALAW)=""
- SET GMTSALAS="No known allergies"
- +2 SET GMTSALAD=$$GET1^DIQ(120.86,+($GET(DFN)),3,"I",,"GMTSALG2")
- IF $DATA(GMTSALG2)
- SET GMTSALAD=""
- IF +GMTSALAD=0
- SET GMTSALAD=""
- +3 IF +GMTSALAD>0
- SET X=GMTSALAD
- DO REGDT4^GMTSU
- SET GMTSALAD=X
- +4 SET GMTSAU=$$GET1^DIQ(120.86,+($GET(DFN)),2,"I")
- +5 SET GMTSALAW=$$GET1^DIQ(200,(+GMTSAU_","),.01,"E",,"GMTSALG3")
- +6 SET GMTSALAT=$$GET1^DIQ(200,(+GMTSAU_","),20.3)
- +7 IF $DATA(GMTSALG3)
- SET (GMTSALAW,GMTSALAT)=""
- +8 QUIT
- AUTOV ; Autoverify
- +1 SET GMTSAV=0
- SET GMTSALNM=$PIECE(GMTSAL(II,JJ,KK,L),U)
- SET GMTSAFN=$GET(^GMR(120.8,GMTSALNM,0))
- +2 IF $PIECE(GMTSAFN,U,18)=""
- IF $PIECE(GMTSAFN,U,16)=1
- SET GMTSAV=1
- +3 QUIT
- TITLE ; Print title
- +1 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +2 IF $DATA(GMTSPNF)
- WRITE ?21,TITLE,!
- +3 IF '$TEST
- WRITE ?21,"Title: ",TITLE,!
- +4 QUIT
- TEXT ; Setup for print of allergy comments
- +1 WRITE ?31,CD
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +2 KILL ^UTILITY($JOB,"W")
- SET GMTSLN=0
- FOR
- SET GMTSLN=$ORDER(^GMR(120.8,GMTSALNM,26,CCC,2,GMTSLN))
- IF 'GMTSLN
- QUIT
- SET GMTSPRT=^GMR(120.8,GMTSALNM,26,CCC,2,GMTSLN,0)
- DO FORMAT
- +3 IF $DATA(^UTILITY($JOB,"W"))
- FOR GMTSLN=1:1:^UTILITY($JOB,"W",DIWL)
- DO LINE
- IF $DATA(GMTSQIT)
- QUIT
- +4 KILL ^UTILITY($JOB,"W")
- +5 IF 'GMTSLN
- QUIT
- +6 WRITE !
- QUIT
- FORMAT ; Formats each line
- +1 SET DIWL=3
- SET DIWR=80
- SET DIWF="C58"
- SET X=GMTSPRT
- DO ^DIWP
- +2 QUIT
- LINE ; Writes formatted lines of text
- +1 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !,?24,^UTILITY($JOB,"W",DIWL,GMTSLN,0)
- +2 QUIT
- SIGBLK(GMTSALF) ; Signature block
- +1 IF +GMTSALF'>0
- QUIT
- NEW GMTSSB,GMTSST,GMTSSN
- SET GMTSSB=$$GET1^DIQ(200,(+GMTSALF_","),20.2)
- SET GMTSST=$$GET1^DIQ(200,(+GMTSALF_","),20.3)
- SET GMTSSN=$$GET1^DIQ(200,(+GMTSALF_","),.01)
- +2 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !!,?24,"Originator: ",$SELECT(GMTSSB'="":GMTSSB,1:GMTSSN)
- +3 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF $LENGTH(GMTSST)
- WRITE !,?24,"Title: ",GMTSST
- +4 QUIT
- INACTIVE(NODE) ;IHS/MSC/MGH Display the inactive data as needed
- +1 NEW N,MX,ALL
- +2 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !,?15,"Inactivation: ",$PIECE(NODE,U,1)_"( "_$PIECE(NODE,U,2)_" )"
- +3 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !,?15,"Reactivation: ",$PIECE(NODE,U,4)
- +4 QUIT
- UNASS(DFN) ;IHS/MSC/MGH Check if patient is unassessable
- +1 NEW Y,IIEN,INIEN
- +2 SET (GMRAUNDT,GMRAUNRE)=""
- +3 SET Y=9999999
- SET Y=$ORDER(^GMR(120.86,DFN,9999999.11,Y),-1)
- IF +Y
- Begin DoDot:1
- +4 IF $PIECE($GET(^GMR(120.86,DFN,9999999.11,Y,0)),U,4)=""
- Begin DoDot:2
- +5 SET INIEN=Y_","_DFN
- +6 SET GMRAUNDT=$$GET1^DIQ(120.869999911,INIEN,.01)
- +7 SET GMRAUNRE=$$GET1^DIQ(120.869999911,INIEN,1)
- End DoDot:2
- End DoDot:1
- +8 QUIT
