Index: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDA.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDA.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDA.m	(revision 623)
@@ -1,44 +1,43 @@
-GMTSDA	; SLC/DLT,KER/NDBI - Appointments ; 5/21/07 11:12am
-	;;2.7;Health Summary;**5,19,28,49,70,80**;Oct 20, 1995;Build 9
-	;               
-	; External Reference
-	;   DBIA  1024  ^DIC(40.7
-	;   DBIA 10040  ^SC(
-	;   DBIA  2065  ^SCE(
-	;   DBIA  2065  ^SCE("ADFN"
-	;   DBIA  2929  CVP^A7RHSM
-	;   DBIA 10061  SDA^VADPT
-	;                   
-PAST	; Gets Patient's Past Appointments for date range
-	N GMDT,GMIDT,MAX S X=1
-	S VASD("F")=$S(GMTSBEG=1:2560101,1:GMTSBEG),VASD("T")=$S(GMTS1=6666666:DT,1:9999999-GMTS1)
-	S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
-	S VASD("W")=123456789 D SDA^VADPT
-	I VAERR=1 D CKP^GMTSUP W "RSA ERROR",! D END Q
-	I VAERR=2 D CKP^GMTSUP W "DATABASE NOT AVAILABLE",! D END Q
-	S (YCNT,Y)=0 F  S Y=$O(^UTILITY("VASD",$J,Y)) Q:'Y  S YCNT=YCNT+1,ADATE=$P(^(Y,"I"),U,1),^UTILITY("GMTSVASD",$J,9999999-ADATE)=ADATE_U_$P(^UTILITY("VASD",$J,Y,"E"),U,2,99)
-	S GMDT=VASD("F")
-	F  S GMDT=$O(^SCE("ADFN",DFN,GMDT)) Q:GMDT'>0!(GMDT>VASD("T"))  D
-	. S GMI=0 F  S GMI=$O(^SCE("ADFN",DFN,GMDT,GMI)) Q:GMI'>0  D
-	. . S GMIDT=9999999-GMDT
-	. . I '$D(^UTILITY("GMTSVASD",$J,GMIDT)) D
-	. . . Q:$P($G(^SCE(GMI,0)),U,6)'=""
-	. . . I $P($G(^SCE(GMI,0)),U,4) Q:$P($G(^SC($P(^SCE(GMI,0),U,4),"OOS")),U)
-	. . . S ^UTILITY("GMTSVASD",$J,GMIDT)=GMDT_U_$S(+$P(^SCE(GMI,0),U,4):$P($G(^SC(+$P(^(0),U,4),0)),U),1:$P($G(^DIC(40.7,$P(^SCE(GMI,0),U,3),0)),U))_U_"UNSCHEDULED"
-	D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) CVP^A7RHSM
-	I '$D(^UTILITY("GMTSVASD",$J)) D END Q
-	S IDATE="",YCNT=0
-	F  S IDATE=$O(^UTILITY("GMTSVASD",$J,IDATE)) Q:+IDATE'>0!(YCNT=MAX)  D
-	. S ADATE=+^(IDATE),ADATE(0)=^(IDATE) D PRINT S YCNT=YCNT+1
-	D END Q
-FUTURE	; Gets Patient's Future Appointments 
-	D SDA^VADPT N MAX S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
-	I VAERR=2 D CKP^GMTSUP W "DATABASE NOT AVAILABLE",! D END Q
-	S (YCNT,Y)=0 F  S Y=$O(^UTILITY("VASD",$J,Y)) Q:'Y  S YCNT=YCNT+1,ADATE=$P(^(Y,"I"),U,1),ADATE(0)=^UTILITY("VASD",$J,Y,"E") D PRINT Q:YCNT=MAX
-	D END Q
-PRINT	; Output
-	D CKP^GMTSUP Q:$D(GMTSQIT)  S X=ADATE D REGDTM4^GMTSU,CKP^GMTSUP
-	W X,?18,$E($P(ADATE(0),"^",2),1,25),?58,$E($P(ADATE(0),"^",3),1,21)
-	W ! Q
-END	; Clean-up and Quit
-	K %I,IDATE,IDATES,ADATE,VASD,X,Y,YCNT,Z,^UTILITY("VASD",$J),^UTILITY("GMTSVASD",$J) Q
+GMTSDA ; SLC/DLT,KER/NDBI - Appointments ; 02/27/2002 [4/14/04 1:53pm]
+ ;;2.7;Health Summary;**5,19,28,49,70**;Oct 20, 1995;Build 5
+ ;               
+ ; External Reference
+ ;   DBIA  1024  ^DIC(40.7
+ ;   DBIA 10040  ^SC(
+ ;   DBIA  2065  ^SCE(
+ ;   DBIA  2065  ^SCE("ADFN"
+ ;   DBIA  2929  CVP^A7RHSM
+ ;   DBIA 10061  SDA^VADPT
+ ;                   
+PAST ; Gets Patient's Past Appointments for date range
+ N GMDT,GMIDT,MAX S X=1
+ S VASD("F")=$S(GMTSBEG=1:2560101,1:GMTSBEG),VASD("T")=$S(GMTS1=6666666:DT,1:9999999-GMTS1)
+ S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
+ S VASD("W")=123456789 D SDA^VADPT
+ I VAERR=2 D CKP^GMTSUP W "DATABASE NOT AVAILABLE",! D END Q
+ S (YCNT,Y)=0 F  S Y=$O(^UTILITY("VASD",$J,Y)) Q:'Y  S YCNT=YCNT+1,ADATE=$P(^(Y,"I"),U,1),^UTILITY("GMTSVASD",$J,9999999-ADATE)=ADATE_U_$P(^UTILITY("VASD",$J,Y,"E"),U,2,99)
+ S GMDT=VASD("F")
+ F  S GMDT=$O(^SCE("ADFN",DFN,GMDT)) Q:GMDT'>0!(GMDT>VASD("T"))  D
+ . S GMI=0 F  S GMI=$O(^SCE("ADFN",DFN,GMDT,GMI)) Q:GMI'>0  D
+ . . S GMIDT=9999999-GMDT
+ . . I '$D(^UTILITY("GMTSVASD",$J,GMIDT)) D
+ . . . Q:$P($G(^SCE(GMI,0)),U,6)'=""
+ . . . I $P($G(^SCE(GMI,0)),U,4) Q:$P($G(^SC($P(^SCE(GMI,0),U,4),"OOS")),U)
+ . . . S ^UTILITY("GMTSVASD",$J,GMIDT)=GMDT_U_$S(+$P(^SCE(GMI,0),U,4):$P($G(^SC(+$P(^(0),U,4),0)),U),1:$P($G(^DIC(40.7,$P(^SCE(GMI,0),U,3),0)),U))_U_"UNSCHEDULED"
+ D:$$ROK^GMTSU("A7RHSM")&($$NDBI^GMTSU) CVP^A7RHSM
+ I '$D(^UTILITY("GMTSVASD",$J)) D END Q
+ S IDATE="",YCNT=0
+ F  S IDATE=$O(^UTILITY("GMTSVASD",$J,IDATE)) Q:+IDATE'>0!(YCNT=MAX)  D
+ . S ADATE=+^(IDATE),ADATE(0)=^(IDATE) D PRINT S YCNT=YCNT+1
+ D END Q
+FUTURE ; Gets Patient's Future Appointments 
+ D SDA^VADPT N MAX S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
+ I VAERR=2 D CKP^GMTSUP W "DATABASE NOT AVAILABLE",! D END Q
+ S (YCNT,Y)=0 F  S Y=$O(^UTILITY("VASD",$J,Y)) Q:'Y  S YCNT=YCNT+1,ADATE=$P(^(Y,"I"),U,1),ADATE(0)=^UTILITY("VASD",$J,Y,"E") D PRINT Q:YCNT=MAX
+ D END Q
+PRINT ; Output
+ D CKP^GMTSUP Q:$D(GMTSQIT)  S X=ADATE D REGDTM4^GMTSU,CKP^GMTSUP
+ W X,?18,$E($P(ADATE(0),"^",2),1,25),?58,$E($P(ADATE(0),"^",3),1,21)
+ W ! Q
+END ; Clean-up and Quit
+ K %I,IDATE,IDATES,ADATE,VASD,X,Y,YCNT,Z,^UTILITY("VASD",$J),^UTILITY("GMTSVASD",$J) Q
Index: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSO.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSO.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSO.m	(revision 623)
@@ -1,67 +1,62 @@
-GMTSPSO	; SLC/JER,KER/NDBI - OP Rx Summary Component (V6) ; 08/27/2002
-	;;2.7;Health Summary;**15,28,37,56,78,80**;Oct 20, 1995;Build 9
-	;
-	; External References
-	;   DBIA  10141  $$VERSION^XPDUTL
-	;   DBIA   2931  HS^A7RPSOHS
-	;   DBIA   2931  HS^A7RPSOHS
-	;   DBIA    330  ^PSOHCSUM, ACS^PSOHCSUM
-	;   DBIA    522  ^PS(55,
-	;   DBIA  10035  ^DPT(  file #2
-	;   DBIA   3136  ^PS(59.7,
-	;                    
-MAIN	; OP Rx HS Comp
-	;   Check for version 7 (or greater)   MAIN^GMTSPSO7
-	I $$VERSION^XPDUTL("PSO")'<7 G MAIN^GMTSPSO7
-	;   If not version 7                   MAIN^GMTSPSO
-	N ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP
-	S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"")
-	I PSOBEGIN="" S PSOACT=1 K PSOBEGIN
-	K ^TMP("PSOO",$J),^TMP($J,"GMTSPS")
-	D PROF^PSO52API(DFN,"GMTSPS",1,9999999)
-	D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN)
-	I +$G(^TMP($J,"GMTSPS",DFN,0))<1,'$D(^TMP($J,"GMTSPS",DFN,"ARC")) Q
-	I '$G(^TMP($J,"GMTSPS",DFN,0)),$D(^TMP($J,"GMTSPS",DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Patient Has Archived OP Prescriptions",!
-	;I '$D(^PS(55,DFN,"P")),'$D(^("ARC")),'$D(^TMP("PSOO",$J)) Q
-	;I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Patient Has Archived OP Prescriptions",!
-	I $L($T(ACS^PSOHCSUM))>0 D ACS^PSOHCSUM D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) I '$D(^TMP("PSOO",$J)) Q
-	I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) I '$D(^TMP("PSOO",$J)) Q
-	S GMTSLO=GMTSLO+3
-	S (GMX,GMTOP,IX)=0
-	F  S IX=$O(^TMP("PSOO",$J,IX)) Q:IX'>0  S GMR=$G(^(IX,0)) D WRT
-	S GMTSLO=GMTSLO-3
-	K ^TMP("PSOO",$J)
-	Q
-WRT	; Writes OP Pharmacy Segment Record
-	N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,GUI S GUI=$$HF^GMTSU
-	S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10)
-	;   Don't display when issue date is after To Date
-	Q:+$G(GMRANGE)&(ID>(9999999-GMTS1))
-	F GMV="ID","LFD","ECD" S X=@GMV D REGDT4^GMTSU S @GMV=X K X
-	S MI=$G(^TMP("PSOO",$J,IX,1)),NL=0 I $L(MI)>73 D PARSE
-	S GMD=$P($P(GMR,U,4),";",2)
-	D CKP^GMTSUP Q:$D(GMTSQIT)
-	D:GMTSNPG!(GMX'>0) HEAD W:'GMTOP ! S GMTOP=0 W $P($P(GMR,U,3),";",2)
-	W !,?18,$P(GMR,U,6),?31,$S($P($P(GMR,U,5),";")="S":"ACTIVE/SUSP",1:$P($P(GMR,U,5),";",2)),?45,$P(GMR,U,7),?54,ID,?65,LFD,?76,"("_$P(GMR,U,8)_")",!
-	S GMX=1 I 'NL D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?2,"SIG: ",MI,! S GMTOP=0
-	F GMI=1:1:NL D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W:GMI=1 ?2,"SIG: " W ?7,MI(GMI),! S GMTOP=0
-	D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?4,"Provider: ",$E(GMD,1,22) W:CF ?37,"Cost/Fill: $",$J(CF,6,2)
-	I "EC"[$P($P(GMR,U,5),";"),ECD]"" W ?57,"Exp/Can Dt: "_ECD
-	W ! S GMTOP=0
-	Q
-PARSE	; Parses Medication Instructions
-	N GMI,NW,WPL
-	S NL=$S(($L(MI)/73)>($L(MI)\73):($L(MI)\73)+1,1:$L(MI)\73)
-	S NW=$L(MI," "),WPL=$S((NW/NL)>(NW\NL):(NW\NL)+1,1:NW\NL)
-	F GMI=1:1:NL S MI(GMI)=$P(MI," ",(GMI-1)*WPL+1,GMI*WPL)
-	Q
-HEAD	; Prints Header
-	S GMTOP=1
-	K ^TMP($J,"GMTSPSSYS") D PSS^PSS59P7(1,,"GMTSPSSYS")
-	I GMX'>0,$D(^DPT(DFN,.1)),^(.1)]"",+$G(^TMP($J,"GMTSPSSYS",1,40.1)) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Outpatient prescriptions are cancelled 72 hours after admission",!
-	;I GMX'>0,$D(^DPT(DFN,.1)),^(.1)]"",+($P($G(^PS(59.7,1,40.1)),"^")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Outpatient prescriptions are cancelled 72 hours after admission",!
-	D CKP^GMTSUP Q:$D(GMTSQIT)  W !,"Drug....................................",?65,"Last",!
-	D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem"
-	W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) !
-	Q
+GMTSPSO ; SLC/JER,KER/NDBI - OP Rx Summary Component (V6) ; 08/27/2002
+ ;;2.7;Health Summary;**15,28,37,56,78**;Oct 20, 1995
+ ;
+ ; External References
+ ;   DBIA  10141  $$VERSION^XPDUTL
+ ;   DBIA   2931  HS^A7RPSOHS
+ ;   DBIA   2931  HS^A7RPSOHS
+ ;   DBIA    330  ^PSOHCSUM, ACS^PSOHCSUM
+ ;   DBIA    522  ^PS(55,
+ ;   DBIA  10035  ^DPT(  file #2
+ ;   DBIA   3136  ^PS(59.7,
+ ;                    
+MAIN ; OP Rx HS Comp
+ ;   Check for version 7 (or greater)   MAIN^GMTSPSO7
+ I $$VERSION^XPDUTL("PSO")'<7 G MAIN^GMTSPSO7
+ ;   If not version 7                   MAIN^GMTSPSO
+ N ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP
+ S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"")
+ I PSOBEGIN="" S PSOACT=1 K PSOBEGIN
+ K ^TMP("PSOO",$J)
+ D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN)
+ I '$D(^PS(55,DFN,"P")),'$D(^("ARC")),'$D(^TMP("PSOO",$J)) Q
+ I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Patient Has Archived OP Prescriptions",!
+ I $L($T(ACS^PSOHCSUM))>0 D ACS^PSOHCSUM D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) I '$D(^TMP("PSOO",$J)) Q
+ I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM D:$$ROK^GMTSU("A7RPSOHS")&($$NDBI^GMTSU) HS^A7RPSOHS(DFN) I '$D(^TMP("PSOO",$J)) Q
+ S GMTSLO=GMTSLO+3
+ S (GMX,GMTOP,IX)=0
+ F  S IX=$O(^TMP("PSOO",$J,IX)) Q:IX'>0  S GMR=$G(^(IX,0)) D WRT
+ S GMTSLO=GMTSLO-3
+ K ^TMP("PSOO",$J)
+ Q
+WRT ; Writes OP Pharmacy Segment Record
+ N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,GUI S GUI=$$HF^GMTSU
+ S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10)
+ ;   Don't display when issue date is after To Date
+ Q:+$G(GMRANGE)&(ID>(9999999-GMTS1))
+ F GMV="ID","LFD","ECD" S X=@GMV D REGDT4^GMTSU S @GMV=X K X
+ S MI=$G(^TMP("PSOO",$J,IX,1)),NL=0 I $L(MI)>73 D PARSE
+ S GMD=$P($P(GMR,U,4),";",2)
+ D CKP^GMTSUP Q:$D(GMTSQIT)
+ D:GMTSNPG!(GMX'>0) HEAD W:'GMTOP ! S GMTOP=0 W $P($P(GMR,U,3),";",2)
+ W !,?18,$P(GMR,U,6),?31,$S($P($P(GMR,U,5),";")="S":"ACTIVE/SUSP",1:$P($P(GMR,U,5),";",2)),?45,$P(GMR,U,7),?54,ID,?65,LFD,?76,"("_$P(GMR,U,8)_")",!
+ S GMX=1 I 'NL D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?2,"SIG: ",MI,! S GMTOP=0
+ F GMI=1:1:NL D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W:GMI=1 ?2,"SIG: " W ?7,MI(GMI),! S GMTOP=0
+ D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?4,"Provider: ",$E(GMD,1,22) W:CF ?37,"Cost/Fill: $",$J(CF,6,2)
+ I "EC"[$P($P(GMR,U,5),";"),ECD]"" W ?57,"Exp/Can Dt: "_ECD
+ W ! S GMTOP=0
+ Q
+PARSE ; Parses Medication Instructions
+ N GMI,NW,WPL
+ S NL=$S(($L(MI)/73)>($L(MI)\73):($L(MI)\73)+1,1:$L(MI)\73)
+ S NW=$L(MI," "),WPL=$S((NW/NL)>(NW\NL):(NW\NL)+1,1:NW\NL)
+ F GMI=1:1:NL S MI(GMI)=$P(MI," ",(GMI-1)*WPL+1,GMI*WPL)
+ Q
+HEAD ; Prints Header
+ S GMTOP=1
+ I GMX'>0,$D(^DPT(DFN,.1)),^(.1)]"",+($P($G(^PS(59.7,1,40.1)),"^")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Outpatient prescriptions are cancelled 72 hours after admission",!
+ D CKP^GMTSUP Q:$D(GMTSQIT)  W !,"Drug....................................",?65,"Last",!
+ D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem"
+ W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) !
+ Q
Index: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSO7.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSO7.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSO7.m	(revision 623)
@@ -1,61 +1,56 @@
-GMTSPSO7	; SLC/JER/KER - OP Rx Summary Component (V7) ; 08/27/2002
-	;;2.7;Health Summary;**15,28,37,56,78,80**;Oct 20, 1995;Build 9
-	;
-	; External References
-	;   DBIA    330  ^PSOHCSUM, ACS^PSOHCSUM
-	;   DBIA    522  ^PS(55,
-	;   DBIA  10035  ^DPT(  file #2
-	;   DBIA   3136  ^PS(59.7,
-	;   DBIA  10011  ^DIWP
-	;                      
-MAIN	; OP Rx HS Component
-	N ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP
-	S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"")
-	I PSOBEGIN="" S PSOACT=1 K PSOBEGIN
-	K ^TMP("PSOO",$J),^TMP($J,"GMTSPS")
-	D PROF^PSO52API(DFN,"GMTSPS",1,9999999)
-	I +$G(^TMP($J,"GMTSPS",DFN,0))<1,'$D(^TMP($J,"GMTSPS",DFN,"ARC")) Q
-	I '$G(^TMP($J,"GMTSPS",DFN,0)),$D(^TMP($J,"GMTSPS",DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Patient Has Archived OP Prescriptions",!
-	;I '$D(^PS(55,DFN,"P")),'$D(^("ARC")) Q
-	;I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Patient Has Archived OP Prescriptions",!
-	I $L($T(ACS^PSOHCSUM))>0 D ACS^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q
-	I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q
-	S GMTSLO=GMTSLO+3
-	S (GMTOP,GMX,IX)=0
-	F  S IX=$O(^TMP("PSOO",$J,IX)) Q:IX'>0  S GMR=$G(^(IX,0)) D WRT
-	S GMTSLO=GMTSLO-3
-	K ^TMP("PSOO",$J),^UTILITY($J,"W")
-	Q
-WRT	; Writes OP Pharmacy Segment Record
-	N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,DIWL,DIWR,DIWF,GMSIG,GUI S GUI=$$HF^GMTSU
-	S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10)
-	;   Don't display when issue date is after To Date
-	Q:+$G(GMRANGE)&(ID>(9999999-GMTS1))
-	F GMV="ID","LFD","ECD" S X=@GMV D REGDT4^GMTSU S @GMV=X K X
-	S NL=0,DIWL=1,DIWR=73,DIWF="" K ^UTILITY($J,"W")
-	F  S NL=$O(^TMP("PSOO",$J,IX,NL)) Q:NL'>0  D
-	. S X=$G(^TMP("PSOO",$J,IX,NL,0)) D ^DIWP
-	S GMD=$P($P(GMR,U,4),";",2)
-	D CKP^GMTSUP Q:$D(GMTSQIT)
-	D:GMTSNPG!(GMX'>0) HEAD W:'GMTOP ! S GMTOP=0 W $P($P(GMR,U,3),";",2)
-	W !,?18,$P(GMR,U,6),?31,$S($G(GMR)["SUSPENDED":"ACTIVE/SUSP",1:$P($P(GMR,U,5),";",2)),?45,$P(GMR,U,7),?54,ID,?65,LFD,?76,"("_$P(GMR,U,8)_")",!
-	S GMX=1,GMI=0,GMSIG=1
-	F  S GMI=$O(^UTILITY($J,"W",DIWL,GMI)) Q:GMI'>0!$D(GMTSQIT)  D
-	. D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD
-	. S MI=$G(^UTILITY($J,"W",DIWL,GMI,0))
-	. W:GMSIG=1 ?2,"SIG: " S:GMSIG=1 GMSIG=0 W ?7,MI,! S GMTOP=0
-	D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?4,"Provider: ",$E(GMD,1,22) W:CF ?37,"Cost/Fill: $",$J(CF,6,2)
-	I "EC"[$P($P(GMR,U,5),";"),ECD]"" W ?57,"Exp/Can Dt: "_ECD
-	W ! S GMTOP=0
-	Q
-HEAD	; Prints Header
-	;   Only write the next line when there is data
-	S GMTOP=1
-	K ^TMP($J,"GMTSPSSYS") D PSS^PSS59P7(1,,"GMTSPSSYS")
-	I GMX'>0,$D(^DPT(DFN,.1)),^(.1)]"",+$G(^TMP($J,"GMTSPSSYS",1,40.1)) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Outpatient prescriptions are cancelled 72 hours after admission",!
-	;I GMX'>0,$D(^DPT(DFN,.1)),^(.1)]"",+($P($G(^PS(59.7,1,40.1)),"^")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Outpatient prescriptions are cancelled 72 hours after admission",!
-	D CKP^GMTSUP Q:$D(GMTSQIT)  W !,"Drug....................................",?65,"Last",!
-	D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem"
-	W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) !
-	Q
+GMTSPSO7 ; SLC/JER/KER - OP Rx Summary Component (V7) ; 08/27/2002
+ ;;2.7;Health Summary;**15,28,37,56,78**;Oct 20, 1995
+ ;
+ ; External References
+ ;   DBIA    330  ^PSOHCSUM, ACS^PSOHCSUM
+ ;   DBIA    522  ^PS(55,
+ ;   DBIA  10035  ^DPT(  file #2
+ ;   DBIA   3136  ^PS(59.7,
+ ;   DBIA  10011  ^DIWP
+ ;                      
+MAIN ; OP Rx HS Component
+ N ECD,GMR,IX,PSOBEGIN,PSOACT,GMX,GMTOP
+ S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"")
+ I PSOBEGIN="" S PSOACT=1 K PSOBEGIN
+ K ^TMP("PSOO",$J)
+ I '$D(^PS(55,DFN,"P")),'$D(^("ARC")) Q
+ I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Patient Has Archived OP Prescriptions",!
+ I $L($T(ACS^PSOHCSUM))>0 D ACS^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q
+ I $L($T(ACS^PSOHCSUM))'>0 D ^PSOHCSUM I '$D(^TMP("PSOO",$J)) Q
+ S GMTSLO=GMTSLO+3
+ S (GMTOP,GMX,IX)=0
+ F  S IX=$O(^TMP("PSOO",$J,IX)) Q:IX'>0  S GMR=$G(^(IX,0)) D WRT
+ S GMTSLO=GMTSLO-3
+ K ^TMP("PSOO",$J),^UTILITY($J,"W")
+ Q
+WRT ; Writes OP Pharmacy Segment Record
+ N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI,DIWL,DIWR,DIWF,GMSIG,GUI S GUI=$$HF^GMTSU
+ S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10)
+ ;   Don't display when issue date is after To Date
+ Q:+$G(GMRANGE)&(ID>(9999999-GMTS1))
+ F GMV="ID","LFD","ECD" S X=@GMV D REGDT4^GMTSU S @GMV=X K X
+ S NL=0,DIWL=1,DIWR=73,DIWF="" K ^UTILITY($J,"W")
+ F  S NL=$O(^TMP("PSOO",$J,IX,NL)) Q:NL'>0  D
+ . S X=$G(^TMP("PSOO",$J,IX,NL,0)) D ^DIWP
+ S GMD=$P($P(GMR,U,4),";",2)
+ D CKP^GMTSUP Q:$D(GMTSQIT)
+ D:GMTSNPG!(GMX'>0) HEAD W:'GMTOP ! S GMTOP=0 W $P($P(GMR,U,3),";",2)
+ W !,?18,$P(GMR,U,6),?31,$S($G(GMR)["SUSPENDED":"ACTIVE/SUSP",1:$P($P(GMR,U,5),";",2)),?45,$P(GMR,U,7),?54,ID,?65,LFD,?76,"("_$P(GMR,U,8)_")",!
+ S GMX=1,GMI=0,GMSIG=1
+ F  S GMI=$O(^UTILITY($J,"W",DIWL,GMI)) Q:GMI'>0!$D(GMTSQIT)  D
+ . D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD
+ . S MI=$G(^UTILITY($J,"W",DIWL,GMI,0))
+ . W:GMSIG=1 ?2,"SIG: " S:GMSIG=1 GMSIG=0 W ?7,MI,! S GMTOP=0
+ D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?4,"Provider: ",$E(GMD,1,22) W:CF ?37,"Cost/Fill: $",$J(CF,6,2)
+ I "EC"[$P($P(GMR,U,5),";"),ECD]"" W ?57,"Exp/Can Dt: "_ECD
+ W ! S GMTOP=0
+ Q
+HEAD ; Prints Header
+ ;   Only write the next line when there is data
+ S GMTOP=1
+ I GMX'>0,$D(^DPT(DFN,.1)),^(.1)]"",+($P($G(^PS(59.7,1,40.1)),"^")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Outpatient prescriptions are cancelled 72 hours after admission",!
+ D CKP^GMTSUP Q:$D(GMTSQIT)  W !,"Drug....................................",?65,"Last",!
+ D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?18,"Rx #",?31,"Stat",?45,"Qty",?54,"Issued",?65,"Filled",?76,"Rem"
+ W:$Y'>(IOSL-GMTSLO)!(+($G(GUI))>0) !
+ Q
Index: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSZO.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSZO.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSPSZO.m	(revision 623)
@@ -1,43 +1,39 @@
-GMTSPSZO	;SLC/JER - OP Rx 5.6 Summary Component ;12/2/91  13:45 ;
-	;;2.7;Health Summary;**80**;Oct 20, 1995;Build 9
-GMTSPSO	;SLC/JER - OP Rx Summary Component ;12/2/91  13:45 ;
-	;;2.7;Health Summary;;Oct 20, 1995
-MAIN	N ECD,GMR,GMW,IX,PSOBEGIN
-	S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"")
-	I PSOBEGIN="" S PSOACT=1
-	K ^UTILITY("PSOO",$J),^TMP($J,"GMTSPS")
-	D PROF^PSO52API(DFN,"GMTSPS",1,9999999)
-	I +$G(^TMP($J,"GMTSPS",DFN,0))<1,'$D(^TMP($J,"GMTSPS",DFN,"ARC")) Q
-	I '$G(^TMP($J,"GMTSPS",DFN,0)),$D(^TMP($J,"GMTSPS",DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Patient Has Archived OP Prescriptions",!
-	;I '$D(^PS(55,DFN,"P")),'$D(^("ARC")) Q
-	;I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Patient Has Archived OP Prescriptions",!
-	D ^PSOHCSUM I '$D(^UTILITY("PSOO",$J)) Q
-	I $D(^DPT(DFN,.1)),^(.1)]"",$D(^DIC(59,+$O(^DIC(59,0)),1)),$P(^(1),"^",8) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Outpatient prescriptions are cancelled 72 hours after admission",!
-	S GMTSLO=GMTSLO+3
-	D HEAD
-	S IX=0 F  S IX=$O(^UTILITY("PSOO",$J,IX)) Q:IX'>0  S GMR=$G(^(IX,0)) D WRT
-	S GMTSLO=GMTSLO-3
-	K ^UTILITY("PSOO",$J)
-	Q
-HEAD	; Prints Header
-	D CKP^GMTSUP Q:$D(GMTSQIT)  W ?67,"Last",!
-	D CKP^GMTSUP Q:$D(GMTSQIT)
-	W "Drug",?27,"Rx #",?38,"St (Exp/Can)",?51,"Qty",?58,"Issued",?67,"Filled",?76,"Rem",! W:$Y'>(IOSL-GMTSLO) !
-	Q
-WRT	; Writes OP Pharmacy Segment Record
-	N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI
-	S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10)
-	F GMV="ID","LFD","ECD" S X=@GMV D REGDT^GMTSU S @GMV=X K X
-	S MI=$G(^UTILITY("PSOO",$J,IX,1)),NL=0 I $L(MI)>73 D PARSE
-	S GMD=$P($P(GMR,U,4),";",2)
-	D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W $E($P($P(GMR,U,3),";",2),1,25),?27,$P(GMR,U,6),?38,$P($P(GMR,U,5),";"),?40,$S("EC"[$P($P(GMR,U,5),";"):"("_ECD_")",1:""),?51,$P(GMR,U,7),?57,ID,?67,LFD,?76,"("_$P(GMR,U,8)_")",!
-	I 'NL D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?2,MI,!
-	F GMI=1:1:NL D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?2,MI(GMI),!
-	D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?4,"Provider: ",$E(GMD,1,26) W:CF ?41,"Cost/Fill: $",$J(CF,6,2) W !
-	Q
-PARSE	; Parses Medication Instructions
-	N GMI,NW,WPL
-	S NL=$S(($L(MI)/73)>($L(MI)\73):($L(MI)\73)+1,1:$L(MI)\73)
-	S NW=$L(MI," "),WPL=$S((NW/NL)>(NW\NL):(NW\NL)+1,1:NW\NL)
-	F GMI=1:1:NL S MI(GMI)=$P(MI," ",(GMI-1)*WPL+1,GMI*WPL)
-	Q
+GMTSPSZO ;SLC/JER - OP Rx 5.6 Summary Component ;12/2/91  13:45 ;
+ ;;2.7;Health Summary;;Oct 20, 1995
+GMTSPSO ;SLC/JER - OP Rx Summary Component ;12/2/91  13:45 ;
+ ;;2.7;Health Summary;;Oct 20, 1995
+MAIN N ECD,GMR,GMW,IX,PSOBEGIN
+ S PSOBEGIN=$S(GMTS2'=9999999:(9999999-GMTS2),1:"")
+ I PSOBEGIN="" S PSOACT=1
+ K ^UTILITY("PSOO",$J) I '$D(^PS(55,DFN,"P")),'$D(^("ARC")) Q
+ I '$O(^PS(55,DFN,"P",0)),$D(^PS(55,DFN,"ARC")) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Patient Has Archived OP Prescriptions",!
+ D ^PSOHCSUM I '$D(^UTILITY("PSOO",$J)) Q
+ I $D(^DPT(DFN,.1)),^(.1)]"",$D(^DIC(59,+$O(^DIC(59,0)),1)),$P(^(1),"^",8) D CKP^GMTSUP Q:$D(GMTSQIT)  W "Outpatient prescriptions are cancelled 72 hours after admission",!
+ S GMTSLO=GMTSLO+3
+ D HEAD
+ S IX=0 F  S IX=$O(^UTILITY("PSOO",$J,IX)) Q:IX'>0  S GMR=$G(^(IX,0)) D WRT
+ S GMTSLO=GMTSLO-3
+ K ^UTILITY("PSOO",$J)
+ Q
+HEAD ; Prints Header
+ D CKP^GMTSUP Q:$D(GMTSQIT)  W ?67,"Last",!
+ D CKP^GMTSUP Q:$D(GMTSQIT)
+ W "Drug",?27,"Rx #",?38,"St (Exp/Can)",?51,"Qty",?58,"Issued",?67,"Filled",?76,"Rem",! W:$Y'>(IOSL-GMTSLO) !
+ Q
+WRT ; Writes OP Pharmacy Segment Record
+ N ID,LFD,X,MI,NL,CF,GMD,GMV,GMI
+ S ID=$P(GMR,U),LFD=$P(GMR,U,2),ECD=$P(GMR,U,11),CF=$P(GMR,U,10)
+ F GMV="ID","LFD","ECD" S X=@GMV D REGDT^GMTSU S @GMV=X K X
+ S MI=$G(^UTILITY("PSOO",$J,IX,1)),NL=0 I $L(MI)>73 D PARSE
+ S GMD=$P($P(GMR,U,4),";",2)
+ D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W $E($P($P(GMR,U,3),";",2),1,25),?27,$P(GMR,U,6),?38,$P($P(GMR,U,5),";"),?40,$S("EC"[$P($P(GMR,U,5),";"):"("_ECD_")",1:""),?51,$P(GMR,U,7),?57,ID,?67,LFD,?76,"("_$P(GMR,U,8)_")",!
+ I 'NL D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?2,MI,!
+ F GMI=1:1:NL D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?2,MI(GMI),!
+ D CKP^GMTSUP Q:$D(GMTSQIT)  D:GMTSNPG HEAD W ?4,"Provider: ",$E(GMD,1,26) W:CF ?41,"Cost/Fill: $",$J(CF,6,2) W !
+ Q
+PARSE ; Parses Medication Instructions
+ N GMI,NW,WPL
+ S NL=$S(($L(MI)/73)>($L(MI)\73):($L(MI)\73)+1,1:$L(MI)\73)
+ S NW=$L(MI," "),WPL=$S((NW/NL)>(NW\NL):(NW\NL)+1,1:NW\NL)
+ F GMI=1:1:NL S MI(GMI)=$P(MI," ",(GMI-1)*WPL+1,GMI*WPL)
+ Q
Index: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAE.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAE.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAE.m	(revision 623)
@@ -1,192 +1,195 @@
-GMTSRAE	; SLC/JER,KER HIN/GJC Selected Radiology Extract ; 04/19/2002
-	;;2.7;Health Summary;**14,25,30,37,40,47,49,51,84**;Oct 20, 1995;Build 6
-	;
-	; External References
-	;   DBIA  3125  ^RADPT( file 70
-	;   DBIA   501  ^RARPT( file 74, fields 5, 200, 300 and 400
-	;   DBIA  3417  ^RA(72, file 72, field 3 pending
-	;   DBIA   502  ^RAMIS(71, file 71, field 9
-	;   DBIA 10015  EN^DIQ1
-	;   DBIA  2056  $$GET1^DIQ (files 71, 72, and 74)
-	;   DBIA  2056  GETS^DIQ (file 70, subfile 70.03)
-	;   DBIA  1995  $$CPT^ICPTCOD
-	;   DBIA 10103  $$DT^XLFDT
-	;   DBIA 10104  $$UP^XLFSTR
-	;   DBIA  1996  $$MOD^ICPTMOD
-	;   DBIA 10011  ^DIWP
-	;                        
-MAINSEL(MODE,TEST)	; Entry for Selection Items
-	N GMTSIDT,GMTSIDT2,GMTSCNT,GMTSPN,GMTSMAX K ^TMP("RAE",$J) S GMTSCNT=0,GMTSMAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999)
-	S GMTSIDT=+GMTS1,GMTSIDT2=+($P(+GMTS2,".",1))_".999999"
-	S:+($G(GMTSPXGO))=0 GMTSIDT=$P(GMTS1,".",1),GMTSIDT2=$P(GMTS2,".",1)_".999999"
-	F  S GMTSIDT=$O(^RADPT(DFN,"DT","AP",TEST,GMTSIDT)) Q:GMTSIDT'>0!(GMTSIDT>GMTSIDT2)!(GMTSCNT=GMTSMAX)  D
-	. Q:'$D(^RADPT(DFN,"DT",GMTSIDT,0))  N GMTS7002,GMTSPSET,GMTSXSET
-	. S GMTS7002=$G(^RADPT(DFN,"DT",GMTSIDT,0))
-	. S GMTSXSET=+$P(GMTS7002,"^",5)
-	. S GMTSPN=0 F  S GMTSPN=$O(^RADPT(DFN,"DT","AP",TEST,GMTSIDT,GMTSPN)) Q:GMTSPN'>0!(GMTSCNT=GMTSMAX)  D
-	. . S GMTSCNT=GMTSCNT+1 D GET
-	Q
-MAIN(MODE)	; Main Entry
-	N GMTSIDT,GMTSCNT,GMTSPN,GMTSMAX
-	K ^TMP("RAE",$J) S GMTSCNT=0,GMTSMAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999)
-	S GMTSIDT=+GMTS1,GMTSIDT2=+($P(+GMTS2,".",1))_".999999"
-	S:+($G(GMTSPXGO))=0 GMTSIDT=$P(GMTS1,".",1),GMTSIDT2=$P(GMTS2,".",1)_".999999"
-	F  S GMTSIDT=$O(^RADPT(DFN,"DT",GMTSIDT)) Q:GMTSIDT'>0!(GMTSIDT>GMTSIDT2)!(GMTSCNT=GMTSMAX)  D
-	. Q:'$D(^RADPT(DFN,"DT",GMTSIDT,0))  N GMTS7002,GMTSPSET,GMTSXSET
-	. S GMTS7002=$G(^RADPT(DFN,"DT",GMTSIDT,0))
-	. S GMTSXSET=+$P(GMTS7002,"^",5)
-	. S GMTSPN=0 F  S GMTSPN=$O(^RADPT(DFN,"DT",GMTSIDT,"P",GMTSPN)) Q:GMTSPN'>0!(+GMTSCNT'<GMTSMAX)  D
-	. . S GMTSCNT=GMTSCNT+1 D GET
-	Q
-	;                   
-GET	; Gets data associated with study and sets global array
-	; ^TMP("RAE",$J, where:
-	;           
-	;    GMTSIDT = inverse exam date/time
-	;    GMTSPN  = Case IEN
-	;           
-	; ^TMP("RAE",$J,GMTSIDT,GMTSPN,0)= <exam date> ^ 
-	; <procedure> ^ <exam status> ^ <report status> ^ 
-	; <prim interpret resident> ^ <prim interpret staff> ^
-	; <CPT code> ^ <technologist> ^ <case number> ^
-	; < exam status order >
-	;           
-	; ^TMP("RAE",$J,GMTSIDT,"EXAMSET") Indicates if all 
-	; exams for this date/time are part of an exam set
-	;           
-	; ^TMP("RAE",$J,GMTSIDT,"PRINTSET") Indicates if all 
-	; exams for this exam set share the same report
-	;           
-	; Only if the report is verified -OR- released will 
-	; these nodes be set
-	;                  
-	; ^TMP("RAE",$J,IDT,PN,"D",seq #) = Dx codes
-	;     Sequence # = 1   Primary Dx
-	;     Sequence # > 1   Secondary Dx
-	; ^TMP("RAE",$J,IDT,PN,"H",line #)= Clinical History line #
-	; ^TMP("RAE",$J,IDT,PN,"S",line #)= Reason for Study line #
-	; ^TMP("RAE",$J,IDT,PN,"I",line #)= Impression Text line #
-	; ^TMP("RAE",$J,IDT,PN,"R",line #)= Report Text line #
-	;           
-	N DA,DIC,DIQ,%,D0,DIW,DIWI,DIWT,DIWTC,DIWX,DIWF,DIWL,DIWR,DN,DR
-	N I,J,Y,Z,GMTSCPT,GMTSED,GMTSCN,GMTSRP,GMTSRPI,GMTSST,GMTSPTR
-	N GMTSTA,GMTSTAI,GMTSI,GMTSRAD,GMTSRRAD,GMTSSRAD,GMTSTC,GMTSSTO
-	N GMTSIMGO,GMTSRA27 S GMTSRA27=$$PROK^GMTSU("RAUTL9",27)
-	S GMTSED=+$P(GMTS7002,"^")
-	S:GMTSXSET&('$D(^TMP("RAE",$J,GMTSIDT,"EXAMSET"))) ^TMP("RAE",$J,GMTSIDT,"EXAMSET")=""
-	;   Get
-	;     Exam Date    $P($G(^RADPT(DFN,"DT",GMTSIDT,0)),"^",1)
-	;     Exam Set     $P($G(^RADPT(DFN,"DT",GMTSIDT,0)),"^",5)
-	;     Case Number             70.03   .01   GMTSCN
-	;     Procedure               70.03    2    GMTSRP/GMTSRPI
-	;     Exam Status             70.03    3    GMTSST
-	;     Imaging Order           70.03   11    GMTSIMGO
-	;     Prim Interpret Resident 70.03   12    GMTSRRAD
-	;     Prim Diagnostic Code    70.03   13    GMTSDX
-	;     Prim Interpreting Staff 70.03   15    GMTSSRAD
-	;     Report Text             70.03   17    
-	;     Member of Set           70.03   25
-	;     Exam Status Order       72       3    GMTSSTO
-	;           
-	S DIC="^RADPT("_DFN_",""DT"","_GMTSIDT_",""P"",",DA=GMTSPN,DIQ="GMTSRAD("
-	S DIQ(0)="IE",DR=".01;2;3;11;12;13;15;17;25" D TECH
-	D EN^DIQ1
-	S GMTSCN=$G(GMTSRAD(70.03,GMTSPN,.01,"E"))
-	S GMTSRP=$G(GMTSRAD(70.03,GMTSPN,2,"E"))
-	S GMTSRPI=$G(GMTSRAD(70.03,GMTSPN,2,"I"))
-	S GMTSST=$G(GMTSRAD(70.03,GMTSPN,3,"E"))
-	S GMTSSTO=$G(GMTSRAD(70.03,GMTSPN,3,"I"))
-	S GMTSSTO=$$GET1^DIQ(72,+GMTSSTO,3,"I")
-	S GMTSIMGO=$G(GMTSRAD(70.03,GMTSPN,11,"I"))  ;Img Order # IEN
-	I GMTSTC S GMTSTC(0)=$E($G(GMTSRAD(70.12,GMTSTC,.01,"E")),1,18)
-	S GMTSRRAD=$E($G(GMTSRAD(70.03,GMTSPN,12,"E")),1,18)
-	S GMTSSRAD=$E($G(GMTSRAD(70.03,GMTSPN,15,"E")),1,18)
-	S GMTSPTR=$G(GMTSRAD(70.03,GMTSPN,17,"I"))
-	; Exam Set/Report
-	;           
-	;     If GMTSPSET = ""   single exam
-	;     If GMTSPSET = 1    exam set, single report
-	;     If GMTSPSET = 2    exam set, combined report
-	;           
-	S GMTSPSET=$G(GMTSRAD(70.03,GMTSPN,25,"I"))
-	D PMOD,CMOD I +GMTSPTR>0 S DIC="^RARPT(",DA=GMTSPTR,DIQ="GMTSRAD(",DIQ(0)="IE",DR="5" D EN^DIQ1
-	S GMTSTA=$G(GMTSRAD(74,+GMTSPTR,5,"E"))
-	S GMTSTAI=$G(GMTSRAD(74,+GMTSPTR,5,"I"))
-	I $L(GMTSTAI),("VR"[$E(GMTSTAI)) D GETDX(GMTSPN_","_GMTSIDT_","_DFN_",")
-	S GMTSCPT=$$GET1^DIQ(71,+GMTSRPI,9,"I")
-	S GMTSCPT=$S(+GMTSCPT>0:$P($$CPT^ICPTCOD(+GMTSCPT),"^",2),1:"")
-	S ^TMP("RAE",$J,GMTSIDT,GMTSPN,0)=GMTSED_U_GMTSRP_U_GMTSST_U_GMTSTA_U_GMTSRRAD_U_GMTSSRAD_U_GMTSCPT_U_$G(GMTSTC(0))_U_GMTSCN_U_$G(GMTSSTO)
-	S GMTSI=0 F  S GMTSI=$O(GMTSRAD(70.1,GMTSI)) Q:+GMTSI'>0  D
-	. S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMTSI)=$G(GMTSRAD(70.1,GMTSI,.01,"E"))
-	S GMTSI=0 F  S GMTSI=$O(GMTSRAD(70.1,GMTSI)) Q:+GMTSI'>0  D
-	. S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMTSI)=$G(GMTSRAD(70.1,GMTSI,.01,"E"))
-	S GMTSI=0 F  S GMTSI=$O(GMTSRAD(70.3135,GMTSI)) Q:+GMTSI'>0  D
-	. Q:'$L($G(GMTSRAD(70.3135,GMTSI,.01,"M")))  Q:'$L($G(GMTSRAD(70.3135,GMTSI,.01,"N")))  N I S I=+($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",0)))+1
-	. S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",I)=$G(GMTSRAD(70.3135,GMTSI,.01,"M"))_"^"_$$UP^XLFSTR($G(GMTSRAD(70.3135,GMTSI,.01,"N")))_"^"_$G(GMTSRAD(70.3135,GMTSI,.01,"N")),^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",0)=I
-	;   Only verified reports can be printed
-	I GMTSTAI'="V",($E(IOST)="P") D  Q
-	. S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
-	;   Only verified & Released/Unverified can viewed
-	I $S(GMTSTAI="V":0,GMTSTAI="R":0,1:1) D  Q
-	. S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
-	Q:$D(^TMP("RAE",$J,GMTSIDT,"PRINTSET"))
-	D GETIMP D:$G(MODE)=2 GETHIS^GMTSRAE1,GETR4S^GMTSRAE1,GETADD,GETREP
-	S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
-	Q
-	;           
-GETIMP	; Gets Radiologist's Impression
-	N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,300,,"GMTST")
-	K ^UTILITY($J,"W") N X,GMTSI S GMTSI=0 F  S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0  S X=$G(GMTST(GMTSI)) D FORMAT
-	I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"I",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
-	K ^UTILITY($J,"W"),GMTST
-	Q
-GETADD	; Gets Additional Clinical History (#74)
-	Q:+($G(GMTSRA27))'>0  N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,400,,"GMTST")
-	K ^UTILITY($J,"W") N X,GMTSI S GMTSI=0 F  S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0  S X=$G(GMTST(GMTSI)) D FORMAT
-	I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) D
-	. S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"A",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
-	K ^UTILITY($J,"W"),GMTST
-	Q
-GETREP	; Gets Radiologist's Report
-	N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,200,,"GMTST")
-	K ^UTILITY($J,"W") N X,I S GMTSI=0 F  S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0  S X=$G(GMTST(GMTSI)) D FORMAT
-	I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"R",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
-	K ^UTILITY($J,"W"),GMTST
-	Q
-PMOD	; Procedure Modifiers
-	N GMTS,GMTSI S GMTS=$G(DIC) Q:'$L(DIC)  S GMTSI=+($G(DA)) Q:+GMTSI=0
-	N DIC,DA,DR S DIC=GMTS_GMTSI_",""M"","
-	S DA=0 F  S DA=$O(@(DIC_DA_")")) Q:+DA'>0  S DR=".01" D
-	. D EN^DIQ1
-	Q
-CMOD	; CPT Modifiers
-	N GMTS,GMTSI,GMTSC,GMTSCM,GMTSCN S GMTS=$G(DIC) Q:'$L(DIC)  S GMTSI=+($G(DA)) Q:+GMTSI=0
-	S DT=$$DT^XLFDT,U="^" N DIC,DA,DR S DIC=GMTS_GMTSI_",""CMOD"","
-	S DA=0 F  S DA=$O(@(DIC_DA_")")) Q:+DA'>0  S DR=".01" D EN^DIQ1
-	S GMTSI=0 F  S GMTSI=$O(GMTSRAD(70.3135,GMTSI)) Q:+GMTSI=0  D
-	. S GMTSC=$G(GMTSRAD(70.3135,GMTSI,.01,"I")) Q:+GMTSC=0
-	. S GMTSCM=$$MOD^ICPTMOD(GMTSC,"I",)
-	. S GMTSCN=$P(GMTSCM,"^",3),GMTSCM=$P(GMTSCM,"^",2)
-	. S GMTSRAD(70.3135,GMTSI,.01,"M")=GMTSCM
-	. S GMTSRAD(70.3135,GMTSI,.01,"N")=$$EN2^GMTSUMX(GMTSCN)
-	Q
-TECH	; Technician
-	S GMTSTC=+$O(^RADPT(DFN,"DT",GMTSIDT,"P",GMTSPN,"TC",0))
-	I GMTSTC S DR=$G(DR)_";175",DR(70.12)=.01,DA(70.12)=GMTSTC F  Q:$E(DR,1)'=";"  S DR=$E(DR,2,$L(DR))
-	Q
-FORMAT	; Calls ^DIWP to format each line of text
-	N DIWL,DIWR,DIWF S DIWL=3,DIWR=($S(MODE=1:76,1:80))
-	D ^DIWP Q
-	;               
-GETDX(GMTSIEN)	; Set the data node with diagnostic code info.
-	;              
-	; Input:  GMTSIEN = Case IEN_","_exam date_","_DFN_","
-	; Output: ^TMP("RAE",$J,GMTSIDT,GMTSPN,"D",seq #) = Dx codes
-	;           
-	; Sequence # = 1   Primary Dx
-	; Sequence # > 1   Secondary Dx
-	S ^TMP("RAE",$J,$P(GMTSIEN,",",2),$P(GMTSIEN,","),"D",1)=$G(GMTSRAD(70.03,$P(GMTSIEN,","),13,"E"))
-	N GMTSI,GMTSII,GMTSDX S GMTSI=1 D GETS^DIQ(70.03,GMTSIEN,"13.1*","E","GMTSDX")
-	S GMTSII="" F  S GMTSII=$O(GMTSDX(70.14,GMTSII)) Q:GMTSII=""  D
-	. S GMTSI=GMTSI+1 S ^TMP("RAE",$J,$P(GMTSIEN,",",2),$P(GMTSIEN,","),"D",GMTSI)=$G(GMTSDX(70.14,GMTSII,.01,"E"))
-	Q
+GMTSRAE ; SLC/JER,KER HIN/GJC Selected Radiology Extract ; 04/19/2002
+ ;;2.7;Health Summary;**14,25,30,37,40,47,49,51**;Oct 20, 1995
+ ;
+ ; External References
+ ;   DBIA  3125  ^RADPT( file 70
+ ;   DBIA   501  ^RARPT( file 74, fields 5, 200, 300 and 400
+ ;   DBIA  3417  ^RA(72, file 72, field 3 pending
+ ;   DBIA   502  ^RAMIS(71, file 71, field 9
+ ;   DBIA 10015  EN^DIQ1
+ ;   DBIA  2056  $$GET1^DIQ (files 71, 72, and 74)
+ ;   DBIA  2056  GETS^DIQ (file 70, subfile 70.03)
+ ;   DBIA  1995  $$CPT^ICPTCOD
+ ;   DBIA 10103  $$DT^XLFDT
+ ;   DBIA 10104  $$UP^XLFSTR
+ ;   DBIA  1996  $$MOD^ICPTMOD
+ ;   DBIA 10011  ^DIWP
+ ;                        
+MAINSEL(MODE,TEST) ; Entry for Selection Items
+ N GMTSIDT,GMTSIDT2,GMTSCNT,GMTSPN,GMTSMAX K ^TMP("RAE",$J) S GMTSCNT=0,GMTSMAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999)
+ S GMTSIDT=+GMTS1,GMTSIDT2=+($P(+GMTS2,".",1))_".999999"
+ S:+($G(GMTSPXGO))=0 GMTSIDT=$P(GMTS1,".",1),GMTSIDT2=$P(GMTS2,".",1)_".999999"
+ F  S GMTSIDT=$O(^RADPT(DFN,"DT","AP",TEST,GMTSIDT)) Q:GMTSIDT'>0!(GMTSIDT>GMTSIDT2)!(GMTSCNT=GMTSMAX)  D
+ . Q:'$D(^RADPT(DFN,"DT",GMTSIDT,0))  N GMTS7002,GMTSPSET,GMTSXSET
+ . S GMTS7002=$G(^RADPT(DFN,"DT",GMTSIDT,0))
+ . S GMTSXSET=+$P(GMTS7002,"^",5)
+ . S GMTSPN=0 F  S GMTSPN=$O(^RADPT(DFN,"DT","AP",TEST,GMTSIDT,GMTSPN)) Q:GMTSPN'>0!(GMTSCNT=GMTSMAX)  D
+ . . S GMTSCNT=GMTSCNT+1 D GET
+ Q
+MAIN(MODE) ; Main Entry
+ N GMTSIDT,GMTSCNT,GMTSPN,GMTSMAX
+ K ^TMP("RAE",$J) S GMTSCNT=0,GMTSMAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999)
+ S GMTSIDT=+GMTS1,GMTSIDT2=+($P(+GMTS2,".",1))_".999999"
+ S:+($G(GMTSPXGO))=0 GMTSIDT=$P(GMTS1,".",1),GMTSIDT2=$P(GMTS2,".",1)_".999999"
+ F  S GMTSIDT=$O(^RADPT(DFN,"DT",GMTSIDT)) Q:GMTSIDT'>0!(GMTSIDT>GMTSIDT2)!(GMTSCNT=GMTSMAX)  D
+ . Q:'$D(^RADPT(DFN,"DT",GMTSIDT,0))  N GMTS7002,GMTSPSET,GMTSXSET
+ . S GMTS7002=$G(^RADPT(DFN,"DT",GMTSIDT,0))
+ . S GMTSXSET=+$P(GMTS7002,"^",5)
+ . S GMTSPN=0 F  S GMTSPN=$O(^RADPT(DFN,"DT",GMTSIDT,"P",GMTSPN)) Q:GMTSPN'>0!(+GMTSCNT'<GMTSMAX)  D
+ . . S GMTSCNT=GMTSCNT+1 D GET
+ Q
+ ;                   
+GET ; Gets data associated with study and sets global array
+ ; ^TMP("RAE",$J, where:
+ ;           
+ ;    GMTSIDT = inverse exam date/time
+ ;    GMTSPN  = Case IEN
+ ;           
+ ; ^TMP("RAE",$J,GMTSIDT,GMTSPN,0)= <exam date> ^ 
+ ; <procedure> ^ <exam status> ^ <report status> ^ 
+ ; <prim interpret resident> ^ <prim interpret staff> ^
+ ; <CPT code> ^ <technologist> ^ <case number> ^
+ ; < exam status order >
+ ;           
+ ; ^TMP("RAE",$J,GMTSIDT,"EXAMSET") Indicates if all 
+ ; exams for this date/time are part of an exam set
+ ;           
+ ; ^TMP("RAE",$J,GMTSIDT,"PRINTSET") Indicates if all 
+ ; exams for this exam set share the same report
+ ;           
+ ; Only if the report is verified -OR- released will 
+ ; these nodes be set
+ ;                  
+ ; ^TMP("RAE",$J,IDT,PN,"D",seq #) = Dx codes
+ ;     Sequence # = 1   Primary Dx
+ ;     Sequence # > 1   Secondary Dx
+ ; ^TMP("RAE",$J,IDT,PN,"H",line #)= Clinical History line #
+ ; ^TMP("RAE",$J,IDT,PN,"I",line #)= Impression Text line #
+ ; ^TMP("RAE",$J,IDT,PN,"R",line #)= Report Text line #
+ ;           
+ N DA,DIC,DIQ,%,D0,DIW,DIWI,DIWT,DIWTC,DIWX,DIWF,DIWL,DIWR,DN,DR
+ N I,J,Y,Z,GMTSCPT,GMTSED,GMTSCN,GMTSRP,GMTSRPI,GMTSST,GMTSPTR
+ N GMTSTA,GMTSTAI,GMTSI,GMTSRAD,GMTSRRAD,GMTSSRAD,GMTSTC,GMTSSTO
+ N GMTSRA27 S GMTSRA27=$$PROK^GMTSU("RAUTL9",27)
+ S GMTSED=+$P(GMTS7002,"^")
+ S:GMTSXSET&('$D(^TMP("RAE",$J,GMTSIDT,"EXAMSET"))) ^TMP("RAE",$J,GMTSIDT,"EXAMSET")=""
+ ;   Get
+ ;     Exam Date    $P($G(^RADPT(DFN,"DT",GMTSIDT,0)),"^",1)
+ ;     Exam Set     $P($G(^RADPT(DFN,"DT",GMTSIDT,0)),"^",5)
+ ;     Case Number             70.03   .01   GMTSCN
+ ;     Procedure               70.03    2    GMTSRP/GMTSRPI
+ ;     Exam Status             70.03    3    GMTSST
+ ;     Prim Interpret Resident 70.03   12    GMTSRRAD
+ ;     Prim Diagnostic Code    70.03   13    GMTSDX
+ ;     Prim Interpreting Staff 70.03   15    GMTSSRAD
+ ;     Report Text             70.03   17    
+ ;     Member of Set           70.03   25
+ ;     Exam Status Order       72       3    GMTSSTO
+ ;           
+ S DIC="^RADPT("_DFN_",""DT"","_GMTSIDT_",""P"",",DA=GMTSPN,DIQ="GMTSRAD("
+ S DIQ(0)="IE",DR=".01;2;3;12;13;15;17;25" D TECH
+ D EN^DIQ1
+ S GMTSCN=$G(GMTSRAD(70.03,GMTSPN,.01,"E"))
+ S GMTSRP=$G(GMTSRAD(70.03,GMTSPN,2,"E"))
+ S GMTSRPI=$G(GMTSRAD(70.03,GMTSPN,2,"I"))
+ S GMTSST=$G(GMTSRAD(70.03,GMTSPN,3,"E"))
+ S GMTSSTO=$G(GMTSRAD(70.03,GMTSPN,3,"I"))
+ S GMTSSTO=$$GET1^DIQ(72,+GMTSSTO,3,"I")
+ I GMTSTC S GMTSTC(0)=$E($G(GMTSRAD(70.12,GMTSTC,.01,"E")),1,18)
+ S GMTSRRAD=$E($G(GMTSRAD(70.03,GMTSPN,12,"E")),1,18)
+ S GMTSSRAD=$E($G(GMTSRAD(70.03,GMTSPN,15,"E")),1,18)
+ S GMTSPTR=$G(GMTSRAD(70.03,GMTSPN,17,"I"))
+ ; Exam Set/Report
+ ;           
+ ;     If GMTSPSET = ""   single exam
+ ;     If GMTSPSET = 1    exam set, single report
+ ;     If GMTSPSET = 2    exam set, combined report
+ ;           
+ S GMTSPSET=$G(GMTSRAD(70.03,GMTSPN,25,"I"))
+ D PMOD,CMOD I +GMTSPTR>0 S DIC="^RARPT(",DA=GMTSPTR,DIQ="GMTSRAD(",DIQ(0)="IE",DR="5" D EN^DIQ1
+ S GMTSTA=$G(GMTSRAD(74,+GMTSPTR,5,"E"))
+ S GMTSTAI=$G(GMTSRAD(74,+GMTSPTR,5,"I"))
+ I $L(GMTSTAI),("VR"[$E(GMTSTAI)) D GETDX(GMTSPN_","_GMTSIDT_","_DFN_",")
+ S GMTSCPT=$$GET1^DIQ(71,+GMTSRPI,9,"I")
+ S GMTSCPT=$S(+GMTSCPT>0:$P($$CPT^ICPTCOD(+GMTSCPT),"^",2),1:"")
+ S ^TMP("RAE",$J,GMTSIDT,GMTSPN,0)=GMTSED_U_GMTSRP_U_GMTSST_U_GMTSTA_U_GMTSRRAD_U_GMTSSRAD_U_GMTSCPT_U_$G(GMTSTC(0))_U_GMTSCN_U_$G(GMTSSTO)
+ S GMTSI=0 F  S GMTSI=$O(GMTSRAD(70.1,GMTSI)) Q:+GMTSI'>0  D
+ . S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMTSI)=$G(GMTSRAD(70.1,GMTSI,.01,"E"))
+ S GMTSI=0 F  S GMTSI=$O(GMTSRAD(70.1,GMTSI)) Q:+GMTSI'>0  D
+ . S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMTSI)=$G(GMTSRAD(70.1,GMTSI,.01,"E"))
+ S GMTSI=0 F  S GMTSI=$O(GMTSRAD(70.3135,GMTSI)) Q:+GMTSI'>0  D
+ . Q:'$L($G(GMTSRAD(70.3135,GMTSI,.01,"M")))  Q:'$L($G(GMTSRAD(70.3135,GMTSI,.01,"N")))  N I S I=+($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",0)))+1
+ . S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",I)=$G(GMTSRAD(70.3135,GMTSI,.01,"M"))_"^"_$$UP^XLFSTR($G(GMTSRAD(70.3135,GMTSI,.01,"N")))_"^"_$G(GMTSRAD(70.3135,GMTSI,.01,"N")),^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",0)=I
+ ;   Only verified reports can be printed
+ I GMTSTAI'="V",($E(IOST)="P") D  Q
+ . S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
+ ;   Only verified & Released/Unverified can viewed
+ I $S(GMTSTAI="V":0,GMTSTAI="R":0,1:1) D  Q
+ . S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
+ Q:$D(^TMP("RAE",$J,GMTSIDT,"PRINTSET"))
+ D GETIMP D:$G(MODE)=2 GETHIS,GETADD,GETREP
+ S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
+ Q
+ ;           
+GETIMP ; Gets Radiologist's Impression
+ N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,300,,"GMTST")
+ K ^UTILITY($J,"W") N X,GMTSI S GMTSI=0 F  S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0  S X=$G(GMTST(GMTSI)) D FORMAT
+ I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"I",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
+ K ^UTILITY($J,"W"),GMTST Q
+ ;
+GETHIS ; Gets Clinical History (#70/#74)
+ N X,GMTSLN
+ I +($G(GMTSRA27))>0 S X=$$GET1^DIQ(70.03,(GMTSPN_","_GMTSIDT_","_DFN_","),400,,"GMTST")
+ I +($G(GMTSRA27))'>0 S X=$$GET1^DIQ(74,GMTSPTR,400,,"GMTST")
+ K ^UTILITY($J,"W") N X,GMTSI S GMTSI=0 F  S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0  S X=$G(GMTST(GMTSI)) D FORMAT
+ I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"H",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
+ K ^UTILITY($J,"W"),GMTST Q
+ Q
+GETADD ; Gets Additional Clinical History (#74)
+ Q:+($G(GMTSRA27))'>0  N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,400,,"GMTST")
+ K ^UTILITY($J,"W") N X,GMTSI S GMTSI=0 F  S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0  S X=$G(GMTST(GMTSI)) D FORMAT
+ I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) D
+ . S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"A",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
+ K ^UTILITY($J,"W"),GMTST Q
+GETREP ; Gets Radiologist's Report
+ N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,200,,"GMTST")
+ K ^UTILITY($J,"W") N X,I S GMTSI=0 F  S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0  S X=$G(GMTST(GMTSI)) D FORMAT
+ I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"R",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
+ K ^UTILITY($J,"W"),GMTST Q
+PMOD ; Procedure Modifiers
+ N GMTS,GMTSI S GMTS=$G(DIC) Q:'$L(DIC)  S GMTSI=+($G(DA)) Q:+GMTSI=0
+ N DIC,DA,DR S DIC=GMTS_GMTSI_",""M"","
+ S DA=0 F  S DA=$O(@(DIC_DA_")")) Q:+DA'>0  S DR=".01" D
+ . D EN^DIQ1
+ Q
+CMOD ; CPT Modifiers
+ N GMTS,GMTSI,GMTSC,GMTSCM,GMTSCN S GMTS=$G(DIC) Q:'$L(DIC)  S GMTSI=+($G(DA)) Q:+GMTSI=0
+ S DT=$$DT^XLFDT,U="^" N DIC,DA,DR S DIC=GMTS_GMTSI_",""CMOD"","
+ S DA=0 F  S DA=$O(@(DIC_DA_")")) Q:+DA'>0  S DR=".01" D EN^DIQ1
+ S GMTSI=0 F  S GMTSI=$O(GMTSRAD(70.3135,GMTSI)) Q:+GMTSI=0  D
+ . S GMTSC=$G(GMTSRAD(70.3135,GMTSI,.01,"I")) Q:+GMTSC=0
+ . S GMTSCM=$$MOD^ICPTMOD(GMTSC,"I",)
+ . S GMTSCN=$P(GMTSCM,"^",3),GMTSCM=$P(GMTSCM,"^",2)
+ . S GMTSRAD(70.3135,GMTSI,.01,"M")=GMTSCM
+ . S GMTSRAD(70.3135,GMTSI,.01,"N")=$$EN2^GMTSUMX(GMTSCN)
+ Q
+TECH ; Technician
+ S GMTSTC=+$O(^RADPT(DFN,"DT",GMTSIDT,"P",GMTSPN,"TC",0))
+ I GMTSTC S DR=$G(DR)_";175",DR(70.12)=.01,DA(70.12)=GMTSTC F  Q:$E(DR,1)'=";"  S DR=$E(DR,2,$L(DR))
+ Q
+FORMAT ; Calls ^DIWP to format each line of text
+ N DIWL,DIWR,DIWF S DIWL=3,DIWR=($S(MODE=1:76,1:80))
+ D ^DIWP Q
+ ;               
+GETDX(GMTSIEN) ; Set the data node with diagnostic code info.
+ ;              
+ ; Input:  GMTSIEN = Case IEN_","_exam date_","_DFN_","
+ ; Output: ^TMP("RAE",$J,GMTSIDT,GMTSPN,"D",seq #) = Dx codes
+ ;           
+ ; Sequence # = 1   Primary Dx
+ ; Sequence # > 1   Secondary Dx
+ S ^TMP("RAE",$J,$P(GMTSIEN,",",2),$P(GMTSIEN,","),"D",1)=$G(GMTSRAD(70.03,$P(GMTSIEN,","),13,"E"))
+ N GMTSI,GMTSII,GMTSDX S GMTSI=1 D GETS^DIQ(70.03,GMTSIEN,"13.1*","E","GMTSDX")
+ S GMTSII="" F  S GMTSII=$O(GMTSDX(70.14,GMTSII)) Q:GMTSII=""  D
+ . S GMTSI=GMTSI+1 S ^TMP("RAE",$J,$P(GMTSIEN,",",2),$P(GMTSIEN,","),"D",GMTSI)=$G(GMTSDX(70.14,GMTSII,.01,"E"))
+ Q
Index: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAS.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAS.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAS.m	(revision 623)
@@ -1,159 +1,159 @@
-GMTSRAS	; SLC/JER,KER HIN/GJC - Radiology Profile       ; 04/19/2002
-	;;2.7;Health Summary;**14,25,28,37,47,51,84**;Oct 20, 1995;Build 6
-	;              
-	; External References
-	;   DBIA  3125  ^RADPT( file 70
-	;   DBIA  2056  $$GET1^DIQ (file 70)
-	;   DBIA 10011  ^DIWP
-	;                        
-ENSRA	; Controls branching
-	Q:+($G(DFN))=0  Q:+($G(DFN))'=+($$RP(+($G(DFN))))
-	N GMDATA D MAIN^GMTSRAE(2) Q:'$D(^TMP("RAE",$J))
-	D LOOP K ^TMP("RAE",$J) Q
-LOOP	; Loops through ^TMP("RAE",$J,
-	N GMW,GMTSORD,GMTSIDT,GMTSPN,GMLN,GMPSET,GMXSET S GMTSIDT=0
-	F  S GMTSIDT=$O(^TMP("RAE",$J,GMTSIDT)) Q:GMTSIDT'>0  D  Q:$D(GMTSQIT)
-	. S GMPSET=$S($D(^TMP("RAE",$J,GMTSIDT,"PRINTSET")):1,1:0)
-	. S GMXSET=$S($D(^TMP("RAE",$J,GMTSIDT,"EXAMSET")):1,1:0)
-	. S GMTSPN=0 F  S GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) Q:GMTSPN'>0  D
-	. . S GMTSORD=+($P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,0)),"^",10))
-	. . D WRT D:+$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) BL Q:$D(GMTSQIT)
-	. D:+$O(^TMP("RAE",$J,GMTSIDT)) BL Q:$D(GMTSQIT)
-	Q
-WRT	; Writes component data
-	Q:$D(GMTSQIT)  N X,GMI,GMTMP S GMDATA=1,GMTMP=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,0))
-	D CKP^GMTSUP Q:$D(GMTSQIT)
-	D DAT,PRO D:'GMPSET SSET D:GMPSET PSET
-	Q
-	;            
-SSET	; Output for Non-Printsets (single exam) (GMPSET=0)
-	;               
-	;  Procedure Modifiers, Procedure Status, 
-	;  CPT Code, CPT Modifiers, Interpreting Staff,
-	;  Interpreting Resident, Report Status, 
-	;  Technologist, Report Text
-	;            
-	D:$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M")) PMD D CPT,CMD,INS,INR,CAS,EST,STT,RPT
-	Q
-PSET	; Output for Printsets (GMPSET=1)
-	;                
-	;  Procedure Modifiers, Procedure Status, 
-	;  CPT Code, CPT Modifier, Report Status, 
-	;  Technologist
-	;            
-	D:$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M")) PMD D CPT,CMD
-	D:'+$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) LSET
-	Q
-LSET	; Last Set/Case in Printset
-	;            
-	;  Interpreting Staff, Interpreting Resident, Report Status, 
-	;  Technologist, Report Text
-	;            
-	D BL,INS,INR,CAS,EST,STT N GMTSPN S GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,0)) D:GMTSPN RPT
-	Q
-	; Data Elements
-DAT	;   Date                                  +1
-	Q:'$L($G(GMTMP))  Q:+($G(GMTMP))=0  Q:'$D(GMXSET)  Q:'$D(GMTSPN)  Q:+($G(GMTSIDT))=0
-	N X,GMTSDT S X=+GMTMP D REGDT4^GMTSU S GMTSDT=X
-	D CKP^GMTSUP Q:$D(GMTSQIT)  W:+($G(GMXSET))=0 GMTSDT
-	W:(+($G(GMXSET))>0)&(GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,0))) GMTSDT
-	Q
-PRO	;   Procedure                              2
-	Q:'$L($G(GMTMP))  N GMTSA,GMTSB S GMTSA=$P($G(GMTMP),"^",2)
-	S:$L(GMTSA)>65 GMTSA=$$WRAP^GMTSORC(GMTSA,65)
-	D CKP^GMTSUP Q:$D(GMTSQIT)  W ?12,$P(GMTSA,"|"),!
-	F GMTSB=2:1:$L(GMTSA,"|") D  Q:$D(GMTSQIT) 
-	. D CKP^GMTSUP Q:$D(GMTSQIT)
-	. W:$P(GMTSA,"|",GMTSB)]"" ?23,$P(GMTSA,"|",GMTSB),!
-	Q
-CAS	;   Case Number                            9
-	Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P(GMTMP,"^",9) Q:GMTSA=""
-	Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?12,"Exam Case Number:",?33,GMTSA,!
-	Q
-EST	;   Exam Status                            3
-	Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P(GMTMP,"^",3) Q:GMTSA=""
-	Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?12,"Exam Status:",?33,GMTSA,!
-	Q
-RST	;   Report Status                          4
-	Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P(GMTMP,"^",4) Q:GMTSA=""
-	Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?12,"Rpt Status:  ",GMTSA,!
-	Q
-INR	;   Interpreting Resident                  5
-	Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P(GMTMP,"^",5) Q:GMTSA=""
-	Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?12,"Interpreting Res.:",?33,GMTSA,!
-	Q
-INS	;   Interpreting Staff                     6
-	Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P(GMTMP,"^",6) Q:GMTSA=""
-	Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?12,"Interpreting Staff:",?33,GMTSA,!
-	Q
-CPT	;   CPT Code                               7
-	Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P($G(GMTMP),"^",7)
-	Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?12,"CPT Code:",?25,GMTSA,!
-	Q
-TEC	;   Technologist                           8
-	Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P($G(GMTMP),"^",8) Q:GMTSA=""
-	Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?12," Technologist: ",GMTSA,!
-	Q
-STT	;   Report Status/Technologist            4/8
-	Q:'$L($G(GMTMP))  N GMTSA,GMTSB S GMTSA=$P(GMTMP,"^",4),GMTSB=$P(GMTMP,"^",8)
-	Q:($G(GMTSA)_$G(GMTSB))=""  Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?12,"Rpt Status:  ",$E($G(GMTSA),1,18) W ?45," Technologist: ",$G(GMTSB),!
-	Q
-CMD	;   CPT Modifiers
-	N GMTSCPTM
-	S GMTSCPTM=+($$CPT^GMTSU(+($G(GMTSEGN)))) S:$G(GMPXCMOD)="N" GMTSCPTM=0
-	Q:'GMTSCPTM  Q:'$L($G(GMTMP))  N GMTSC,GMTSCM,GMTSCT,GMTSI,GMTSCNT S (GMTSC,GMTSCNT)=0
-	F  S GMTSC=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)) Q:+GMTSC=0  D
-	. S GMTSCM=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",1) Q:'$L(GMTSCM)
-	. S GMTSCT=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",3) Q:'$L(GMTSCT)
-	. S GMTSCT=GMTSCM_" - "_GMTSCT
-	. S GMTSCNT=GMTSCNT+1
-	. S:$L(GMTSCT)>47 GMTSCT=$$WRAP^GMTSORC(GMTSCT,47)
-	. D CKP^GMTSUP Q:$D(GMTSQIT)
-	. W:GMTSCNT=1 ?12,"CPT Modifier:" W ?28,$P(GMTSCT,"|"),!
-	. F GMTSI=2:1:$L(GMTSCT,"|") D  Q:$D(GMTSQIT)
-	. . D CKP^GMTSUP Q:$D(GMTSQIT)  W:$P(GMTSCT,"|",GMTSI)]"" ?33,$P(GMTSCT,"|",GMTSI),!
-	Q
-PMD	;   Procedure Modifiers
-	Q:'$L($G(GMTMP))  D CKP^GMTSUP Q:$D(GMTSQIT)  W:+($O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",0)))>0 ?12,"Procedure Modifier:"
-	S GMI=0 F  S GMI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMI)) Q:+GMI'>0  D
-	. D CKP^GMTSUP Q:$D(GMTSQIT)
-	. W ?33,^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMI),!
-	Q
-	;            
-RPT	; Report Text
-	N GMTSL F GMTSL="S","H","A","R","I","D" D TXT(GMTSL)
-	Q
-TXT(X)	;   Report Text Lines
-	N GMTST S GMTST=$E($G(X),1) Q:(GMTST="")!("^S^H^A^R^I^D^"'[GMTST)!(GMTST="^")
-	Q:GMTST="A"&(+($$PROK^GMTSU("RAUTL9",27))=0)
-	Q:+($G(GMTSIDT))=0  Q:+($G(GMTSPN))=0  Q:'$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST))
-	K ^UTILITY($J,"W") N GMTSI,GMTSII,GMTSIND,DIWF,DIWL,DIWR S GMTSIND=12,DIWF="C"_(78-(GMTSIND+2)),DIWL=0,DIWR=0,GMTSI=0
-	D:$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,0))>0 BL
-	D CKP^GMTSUP Q:$D(GMTSQIT)
-	W ?GMTSIND,$S(GMTST="S":"Reason for Study: ",GMTST="H":"History: ",GMTST="A":"Additional History: ",GMTST="R":"Report: ",GMTST="I":"Impression: ",GMTST="D":"DX Codes: ",1:"Text:"),!
-	I GMTST'="D" D
-	. S GMTSI=0 F  S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) Q:GMTSI'>0  D  Q:$D(GMTSQIT)
-	. . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) D ^DIWP
-	I GMTST="D" D
-	. S GMTSI=0 F  S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) Q:GMTSI'>0  D  Q:$D(GMTSQIT)
-	. . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) S:$L(X)>(78-(GMTSIND+4)) X=$$WRAP^GMTSORC(X,(78-(GMTSIND+4)))
-	. . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?(GMTSIND+2),$P(X,"|",1),! F GMTSII=2:1:$L(X,"|") D  Q:$D(GMTSQIT) 
-	. . . D CKP^GMTSUP Q:$D(GMTSQIT)  W:$P(X,"|",GMTSII)]"" ?(GMTSIND+4),$P(X,"|",GMTSII),!
-	I $D(^UTILITY($J,"W")) D
-	. S GMTSI=0 F  S GMTSI=$O(^UTILITY($J,"W",0,GMTSI)) Q:+GMTSI=0  D  Q:$D(GMTSQIT)
-	. . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?(GMTSIND+2),$G(^UTILITY($J,"W",0,GMTSI,0)),!
-	K ^UTILITY($J,"W")
-	Q
-BL	;   Report Blank Lines
-	D CKP^GMTSUP Q:$D(GMTSQIT)  W ! Q
-	;               
-RP(X)	; Radiology Patient
-	N Y S X=+($G(X)) S Y=$$GET1^DIQ(70,X,.01,"I") S X=Y Q X
+GMTSRAS ; SLC/JER,KER HIN/GJC - Radiology Profile       ; 04/19/2002
+ ;;2.7;Health Summary;**14,25,28,37,47,51**;Oct 20, 1995
+ ;              
+ ; External References
+ ;   DBIA  3125  ^RADPT( file 70
+ ;   DBIA  2056  $$GET1^DIQ (file 70)
+ ;   DBIA 10011  ^DIWP
+ ;                        
+ENSRA ; Controls branching
+ Q:+($G(DFN))=0  Q:+($G(DFN))'=+($$RP(+($G(DFN))))
+ N GMDATA D MAIN^GMTSRAE(2) Q:'$D(^TMP("RAE",$J))
+ D LOOP K ^TMP("RAE",$J) Q
+LOOP ; Loops through ^TMP("RAE",$J,
+ N GMW,GMTSORD,GMTSIDT,GMTSPN,GMLN,GMPSET,GMXSET S GMTSIDT=0
+ F  S GMTSIDT=$O(^TMP("RAE",$J,GMTSIDT)) Q:GMTSIDT'>0  D  Q:$D(GMTSQIT)
+ . S GMPSET=$S($D(^TMP("RAE",$J,GMTSIDT,"PRINTSET")):1,1:0)
+ . S GMXSET=$S($D(^TMP("RAE",$J,GMTSIDT,"EXAMSET")):1,1:0)
+ . S GMTSPN=0 F  S GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) Q:GMTSPN'>0  D
+ . . S GMTSORD=+($P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,0)),"^",10))
+ . . D WRT D:+$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) BL Q:$D(GMTSQIT)
+ . D:+$O(^TMP("RAE",$J,GMTSIDT)) BL Q:$D(GMTSQIT)
+ Q
+WRT ; Writes component data
+ Q:$D(GMTSQIT)  N X,GMI,GMTMP S GMDATA=1,GMTMP=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,0))
+ D CKP^GMTSUP Q:$D(GMTSQIT)
+ D DAT,PRO D:'GMPSET SSET D:GMPSET PSET
+ Q
+ ;            
+SSET ; Output for Non-Printsets (single exam) (GMPSET=0)
+ ;               
+ ;  Procedure Modifiers, Procedure Status, 
+ ;  CPT Code, CPT Modifiers, Interpreting Staff,
+ ;  Interpreting Resident, Report Status, 
+ ;  Technologist, Report Text
+ ;            
+ D:$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M")) PMD D CPT,CMD,INS,INR,CAS,EST,STT,RPT
+ Q
+PSET ; Output for Printsets (GMPSET=1)
+ ;                
+ ;  Procedure Modifiers, Procedure Status, 
+ ;  CPT Code, CPT Modifier, Report Status, 
+ ;  Technologist
+ ;            
+ D:$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M")) PMD D CPT,CMD
+ D:'+$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) LSET
+ Q
+LSET ; Last Set/Case in Printset
+ ;            
+ ;  Interpreting Staff, Interpreting Resident, Report Status, 
+ ;  Technologist, Report Text
+ ;            
+ D BL,INS,INR,CAS,EST,STT N GMTSPN S GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,0)) D:GMTSPN RPT
+ Q
+ ; Data Elements
+DAT ;   Date                                  +1
+ Q:'$L($G(GMTMP))  Q:+($G(GMTMP))=0  Q:'$D(GMXSET)  Q:'$D(GMTSPN)  Q:+($G(GMTSIDT))=0
+ N X,GMTSDT S X=+GMTMP D REGDT4^GMTSU S GMTSDT=X
+ D CKP^GMTSUP Q:$D(GMTSQIT)  W:+($G(GMXSET))=0 GMTSDT
+ W:(+($G(GMXSET))>0)&(GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,0))) GMTSDT
+ Q
+PRO ;   Procedure                              2
+ Q:'$L($G(GMTMP))  N GMTSA,GMTSB S GMTSA=$P($G(GMTMP),"^",2)
+ S:$L(GMTSA)>65 GMTSA=$$WRAP^GMTSORC(GMTSA,65)
+ D CKP^GMTSUP Q:$D(GMTSQIT)  W ?12,$P(GMTSA,"|"),!
+ F GMTSB=2:1:$L(GMTSA,"|") D  Q:$D(GMTSQIT) 
+ . D CKP^GMTSUP Q:$D(GMTSQIT)
+ . W:$P(GMTSA,"|",GMTSB)]"" ?23,$P(GMTSA,"|",GMTSB),!
+ Q
+CAS ;   Case Number                            9
+ Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P(GMTMP,"^",9) Q:GMTSA=""
+ Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?12,"Exam Case Number:",?33,GMTSA,!
+ Q
+EST ;   Exam Status                            3
+ Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P(GMTMP,"^",3) Q:GMTSA=""
+ Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?12,"Exam Status:",?33,GMTSA,!
+ Q
+RST ;   Report Status                          4
+ Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P(GMTMP,"^",4) Q:GMTSA=""
+ Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?12,"Rpt Status:  ",GMTSA,!
+ Q
+INR ;   Interpreting Resident                  5
+ Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P(GMTMP,"^",5) Q:GMTSA=""
+ Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?12,"Interpreting Res.:",?33,GMTSA,!
+ Q
+INS ;   Interpreting Staff                     6
+ Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P(GMTMP,"^",6) Q:GMTSA=""
+ Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?12,"Interpreting Staff:",?33,GMTSA,!
+ Q
+CPT ;   CPT Code                               7
+ Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P($G(GMTMP),"^",7)
+ Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?12,"CPT Code:",?25,GMTSA,!
+ Q
+TEC ;   Technologist                           8
+ Q:'$L($G(GMTMP))  N GMTSA S GMTSA=$P($G(GMTMP),"^",8) Q:GMTSA=""
+ Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?12," Technologist: ",GMTSA,!
+ Q
+STT ;   Report Status/Technologist            4/8
+ Q:'$L($G(GMTMP))  N GMTSA,GMTSB S GMTSA=$P(GMTMP,"^",4),GMTSB=$P(GMTMP,"^",8)
+ Q:($G(GMTSA)_$G(GMTSB))=""  Q:$D(GMTSQIT)  D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?12,"Rpt Status:  ",$E($G(GMTSA),1,18) W ?45," Technologist: ",$G(GMTSB),!
+ Q
+CMD ;   CPT Modifiers
+ N GMTSCPTM
+ S GMTSCPTM=+($$CPT^GMTSU(+($G(GMTSEGN)))) S:$G(GMPXCMOD)="N" GMTSCPTM=0
+ Q:'GMTSCPTM  Q:'$L($G(GMTMP))  N GMTSC,GMTSCM,GMTSCT,GMTSI,GMTSCNT S (GMTSC,GMTSCNT)=0
+ F  S GMTSC=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)) Q:+GMTSC=0  D
+ . S GMTSCM=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",1) Q:'$L(GMTSCM)
+ . S GMTSCT=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",3) Q:'$L(GMTSCT)
+ . S GMTSCT=GMTSCM_" - "_GMTSCT
+ . S GMTSCNT=GMTSCNT+1
+ . S:$L(GMTSCT)>47 GMTSCT=$$WRAP^GMTSORC(GMTSCT,47)
+ . D CKP^GMTSUP Q:$D(GMTSQIT)
+ . W:GMTSCNT=1 ?12,"CPT Modifier:" W ?28,$P(GMTSCT,"|"),!
+ . F GMTSI=2:1:$L(GMTSCT,"|") D  Q:$D(GMTSQIT)
+ . . D CKP^GMTSUP Q:$D(GMTSQIT)  W:$P(GMTSCT,"|",GMTSI)]"" ?33,$P(GMTSCT,"|",GMTSI),!
+ Q
+PMD ;   Procedure Modifiers
+ Q:'$L($G(GMTMP))  D CKP^GMTSUP Q:$D(GMTSQIT)  W:+($O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",0)))>0 ?12,"Procedure Modifier:"
+ S GMI=0 F  S GMI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMI)) Q:+GMI'>0  D
+ . D CKP^GMTSUP Q:$D(GMTSQIT)
+ . W ?33,^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMI),!
+ Q
+ ;            
+RPT ; Report Text
+ N GMTSL F GMTSL="H","A","R","I","D" D TXT(GMTSL)
+ Q
+TXT(X) ;   Report Text Lines
+ N GMTST S GMTST=$E($G(X),1) Q:(GMTST="")!("^H^A^R^I^D^"'[GMTST)!(GMTST="^")
+ Q:GMTST="A"&(+($$PROK^GMTSU("RAUTL9",27))=0)
+ Q:+($G(GMTSIDT))=0  Q:+($G(GMTSPN))=0  Q:'$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST))
+ K ^UTILITY($J,"W") N GMTSI,GMTSII,GMTSIND,DIWF,DIWL,DIWR S GMTSIND=12,DIWF="C"_(78-(GMTSIND+2)),DIWL=0,DIWR=0,GMTSI=0
+ D:$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,0))>0 BL
+ D CKP^GMTSUP Q:$D(GMTSQIT)
+ W ?GMTSIND,$S(GMTST="H":"History: ",GMTST="A":"Additional History: ",GMTST="R":"Report: ",GMTST="I":"Impression: ",GMTST="D":"DX Codes: ",1:"Text:"),!
+ I GMTST'="D" D
+ . S GMTSI=0 F  S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) Q:GMTSI'>0  D  Q:$D(GMTSQIT)
+ . . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) D ^DIWP
+ I GMTST="D" D
+ . S GMTSI=0 F  S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) Q:GMTSI'>0  D  Q:$D(GMTSQIT)
+ . . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) S:$L(X)>(78-(GMTSIND+4)) X=$$WRAP^GMTSORC(X,(78-(GMTSIND+4)))
+ . . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?(GMTSIND+2),$P(X,"|",1),! F GMTSII=2:1:$L(X,"|") D  Q:$D(GMTSQIT) 
+ . . . D CKP^GMTSUP Q:$D(GMTSQIT)  W:$P(X,"|",GMTSII)]"" ?(GMTSIND+4),$P(X,"|",GMTSII),!
+ I $D(^UTILITY($J,"W")) D
+ . S GMTSI=0 F  S GMTSI=$O(^UTILITY($J,"W",0,GMTSI)) Q:+GMTSI=0  D  Q:$D(GMTSQIT)
+ . . D CKP^GMTSUP Q:$D(GMTSQIT)  W ?(GMTSIND+2),$G(^UTILITY($J,"W",0,GMTSI,0)),!
+ K ^UTILITY($J,"W")
+ Q
+BL ;   Report Blank Lines
+ D CKP^GMTSUP Q:$D(GMTSQIT)  W ! Q
+ ;               
+RP(X) ; Radiology Patient
+ N Y S X=+($G(X)) S Y=$$GET1^DIQ(70,X,.01,"I") S X=Y Q X
Index: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSUP.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSUP.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSUP.m	(revision 623)
@@ -1,184 +1,183 @@
-GMTSUP	; SLC/KER - Utilities for Paging HS           ; 01/06/2003
-	;;2.7;Health Summary;**2,7,21,27,28,30,35,47,56,58,85**;Oct 20, 1995;Build 24
-	;
-	; External References
-	;   DBIA 10026  ^DIR
-	;   DBIA    82  EN^XQORM
-	;                       
-CKP	; Check page position, pause and prompt
-	Q:$D(GMTSQIT)  S GMTSNPG=0
-	K:$L($G(GMTSOBJ("LABEL"))) GMTSOBJ("REPORT HEADER")
-	I $G(GMTSWRIT)=1 D BREAK S GMTSWRIT=0
-	I +($$HF^GMTSU) D BREAK:(GMTSEGN'=$G(GMTSLCMP)) Q
-	Q:+$G(GMTSLPG)'>0&($Y'>(IOSL-GMTSLO))
-	I $E(IOST,1)="C" S:'$D(GMTSTOF) GMTSTOF=1 D CKP1
-	I '$D(GMTSQIT) W @IOF D HEADER,BREAK S GMTSNPG=1,GMTSTOF=GMTSEGN
-	I $D(GMTSQIT),(GMTSQIT]""),($D(GMTSTYP)) W @IOF D HEADER S GMTSTOF=GMTSEGN
-	Q
-CKP1	; Help Display of Optional Components for Navigation
-	N DA,I,J,K,L,X,XQORM,Y,GMTSY,TYP,DIC
-	I $S('$D(GMTSTYP):1,$D(GMTOPT):1,1:0) N DIR S DIR(0)="E" D ^DIR K DIR S:$D(DUOUT)!(GMTSLPG) GMTSQIT="" Q
-	S TYP=GMTSTYP
-	S DIC=142,DIC(0)="MZF",X="GMTS HS ADHOC OPTION" S Y=$$TYPE^GMTSULT
-	S GMTSTYP=+Y K DIC,X,Y
-	S XQORM=GMTSTYP_";GMT(142,",XQORM(0)="1AF\+",XQORM("A")="Press <RET> to continue, ^ to exit, or select component: "
-	S XQORM("??")="D HELP^GMTSUP1" I GMTSLPG,'$D(GMTSOBJ) W:'$D(GMTSOBJE) "* END * "
-	S XQORM("S")="I $D(^GMT(142,DA(1),1,DA,0)),($P(^GMT(142.1,$P(^GMT(142,DA(1),1,DA,0),U,2),0),U,6)'=""T"")"
-	D EN^XQORM W ! D @$S(Y=1:"BRNCH",1:"EVAL")
-	I $D(GMTSY),(GMTSY=0) K GMTSY G CKP1
-	S GMTSTYP=TYP
-	Q
-BREAK	; Writes the Component Header
-	;           
-	;   If the variable GMTSOBJ exist, then the 
-	;   Component Headers are suppressed with the
-	;   following exceptions:
-	;           
-	;       If GMTSOBJ("COMPONENT HEADER") exist,
-	;       then the Component Header will NOT be
-	;       suppressed
-	;           
-	;       If GMTSOBJ("BLANK LINE") exist, a blank
-	;       line will be written after the Component
-	;       Header
-	;              
-	N GMTSM,GMTSF S GMTSM=$$MUL,GMTSF=$$FST
-	I +GMTSM=0,$D(GMTSOBJ),'$D(GMTSOBJ("COMPONENT HEADER")),'$D(GMTSOBJ("BLANK LINE")) Q
-	N GMTS,GMTSUL,GMTSL S:'$D(GMTSLCMP) GMTSLCMP=0
-	S GMTSUL="",GMTSNPG=1,GMTS=$$CHDR,GMTSL=+($L($G(GMTS))),$P(GMTSUL,"-",+GMTSL)="-"
-	I $Y'>(IOSL-GMTSLO)!(+($$HF^GMTSU)) D
-	. I $D(GMTSOBJ) D  Q
-	. . S GMTSLCMP=GMTSEGN
-	. . I +($G(GMTSM))>0!($D(GMTSOBJ("COMPONENT HEADER"))) D
-	. . . W:+GMTSF=0 ! W !,GMTS W:$D(GMTSOBJ("UNDERLINE")) !,GMTSUL
-	. . . W ! W:$D(GMTSOBJ("BLANK LINE")) !
-	. W !,GMTS,!
-	. W:$Y'>(IOSL-GMTSLO) ?34,$S(GMTSEGN=GMTSLCMP:"(continued)",1:""),!
-	. S GMTSLCMP=GMTSEGN
-	Q
-OLDB	;
-	S:'$D(GMTSLCMP) GMTSLCMP=0
-	S GMTS="",GMTSNPG=1
-	S $P(GMTS,"-",79-$L(GMTSEGH_GMTSEGL)/2)=""
-	S GMTS=GMTS_" "_GMTSEGH_GMTSEGL_" "_GMTS
-	I $Y'>(IOSL-GMTSLO)!(+($$HF^GMTSU)) D
-	. W !,GMTS,!
-	. W:$Y'>(IOSL-GMTSLO) ?34,$S(GMTSEGN=GMTSLCMP:"(continued)",1:""),!
-	. S GMTSLCMP=GMTSEGN
-	       Q
-HEADER	; Print Running Header
-	;           
-	;   If the variable GMTSOBJ exist, then the 
-	;   Report Headers are suppressed with the 
-	;   following exceptions:
-	;           
-	;       If GMTSOBJ("DATE LINE") exist, then the
-	;       Location/Report Date line will NOT be
-	;       suppressed.
-	;           
-	;       If GMTSOBJ("CONFIDENTIAL") exist, then
-	;       the Confidential Header Name line will
-	;       NOT be suppressed.
-	;           
-	;       If GMTSOBJ("REPORT HEADER") exist, then
-	;       the Report Header containing the patient's
-	;       name, SSAN, ward and DOB will NOT be
-	;       suppressed.
-	;              
-	;       If the variable GMTSOBJ("LABEL") contains
-	;       text, and the variable GMTSOBJ("USE LABEL")
-	;       exist, then this text will be printed before
-	;       the object text.
-	;                 
-	;       If GMTSOBJ("REPORT DECEASED") exist, then
-	;       the optional line that displays for Deceased
-	;       patients will NOT be suppressed.
-	;                 
-	;   Header Lines:
-	N GMTSVDT,DATA S DATA="" I +$G(GMTSPXD1)&+$G(GMTSPXD2) D
-	. Q:$G(GMTSOBJ)  S:'$D(GMTSOBJE) DATA="Printed for data "  S:$D(GMTSOBJE) DATA="Include data "
-	. I GMTSPXD1=GMTSPXD2 S DATA=DATA_"on "_GMTSPXD1 Q
-	. S DATA=DATA_"from "_GMTSPXD2_" to "_GMTSPXD1
-	I $D(GMTSCDT(0)),'$D(GMTSOBJ) S GMTSVDT=GMTSCDT(0) S:GMTSDTM'["Printed:" GMTSDTM="Printed: "_GMTSDTM
-	;     Location and Date of Report
-	I '$D(GMTSOBJ)!($D(GMTSOBJ("DATE LINE"))) D
-	. N GMTSLOC S GMTSLOC=$S('$D(GMTSOBJ("DATE LINE")):$P($G(GMTSSC),U,2),1:"")
-	. W !,$S($L(GMTSLOC):"Location: "_GMTSLOC_" ",1:"")
-	. W $S($D(GMTSVDT):GMTSVDT,1:"")
-	. W:'$D(GMTSOBJ("DATE LINE")) DATA,?(79-$L(GMTSDTM)),GMTSDTM
-	. W:$D(GMTSOBJ("DATE LINE")) DATA,?(74-$L(GMTSDTM)),GMTSDTM
-	;     Confidential Header Name
-	S:'$D(GMTSPG) GMTSPG=0
-	S GMTSPG=GMTSPG+1,GMTSHDR=" CONFIDENTIAL "_GMTSTITL_" SUMMARY "
-	S GMTSHDR=GMTSHDR_$S($E(IOST,1)="C":"",1:"  pg. "_GMTSPG)
-	S GMTS="" S:'$D(GMTSOBJ) $P(GMTS,"*",(77-$L(GMTSHDR))\2)="*"
-	S:$D(GMTSOBJ) $P(GMTS,"*",(72-$L(GMTSHDR))\2)="*"
-	S GMTSHDR=GMTS_" "_GMTSHDR_" "_GMTS
-	I '$D(GMTSOBJ)!($D(GMTSOBJ("CONFIDENTIAL"))) W !,GMTSHDR,"*"
-	;     Name, SSAN, Ward, DOB
-	I '$D(GMTSLFG) D
-	.I $G(GMTSTITL)'["AD HOC",($G(GMTSTITL)'["PDX"),($G(HSTAG)="") D EN^GMTSHCPR  ;GMTS,85 restrict ssn/dob on HS Type hard copies 
-	. I $G(GMTSPHDR("TWO")) D
-	. . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")),$L($G(GMTSOBJ("LABEL"))) D LABEL
-	. . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")) Q
-	. . W !,GMTSPHDR("NMSSN"),?GMTSPHDR("DOBS"),GMTSPHDR("DOB")
-	. . W !,?GMTSPHDR("WARDRBS"),GMTSPHDR("WARDRB")
-	. E  D
-	. . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")),$L($G(GMTSOBJ("LABEL"))) D LABEL
-	. . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")) Q
-	. . W !,GMTSPHDR("NMSSN"),?GMTSPHDR("WARDRBS")
-	. . W GMTSPHDR("WARDRB"),?GMTSPHDR("DOBS"),GMTSPHDR("DOB")
-	;     Deceased
-	;                    
-	I '$D(GMTSOBJ)!($D(GMTSOBJ("DECEASED"))) D
-	. W:+$G(VADM(6)) !,?26,"** DECEASED   "_$P(VADM(6),U,2)_" **"
-	W:'$D(GMTSOBJ) !
-	Q
-BRNCH	; Checks abbreviation to branch to a different component
-	N GMTINX,LIM,CREC,SBS
-	I Y,("+-"[X) S:X="-" GMTSEGN=GMTSTOF-1 S (GMTSY,GMTSQIT)=1,GMTSLPG=0 Q
-	I X="^^" S DIROUT=1,GMTSQIT="" Q
-	I Y,(X?1"^^".E) Q
-	S GMTINX=$S($D(^GMT(142,GMTSTYP,1,+Y(1),0)):$P(^(0),U,2),1:"")
-	I 'GMTINX S GMTSY=0 Q
-	I '$D(GMTSEGI(GMTINX)) N GMI,GMJ,GMTSDFLT S GMI=1,GMJ=GMTSEGC,GMTSDFLT=1 D LOAD^GMTSADH S GMTSEGC=GMTSEGC+1
-	I '$D(GMTSEGI(GMTINX)) S GMTINX="",GMTSY=0 Q
-	S LIM=$P(Y(1),U,4) I LIM'["=" G NOLIM
-	S CREC=^GMT(142.1,GMTINX,0),SBS=GMTSEGI(GMTINX) D CMPLIM^GMTSADH2
-	I $D(DIROUT) S GMTSQIT="" Q
-NOLIM	; No limits
-	S GMTSEGN=GMTSEGI(GMTINX)-1,(GMTSY,GMTSQIT)=1,GMTSLPG=0
-	Q
-	;
-EVAL	; Evaluate input to determine quit or continue
-	Q:'$D(X)
-	S:$D(GMTSEXIT) GMTSEXIT=$G(X)
-	S:$D(DTOUT) DIROUT=1 I $S(X="^^":1,GMTSLPG:1,$D(DIROUT):1,X="^":1,1:0) S GMTSQIT=""
-	I +$G(GMPSAP),(X="^") S GMDUOUT=1
-	Q
-MUL(X)	; Multiple Components in Type
-	N GMTSF,GMTSL S GMTSF=$O(GMTSEG(0)),GMTSL=$O(GMTSEG(" "),-1)
-	Q:+GMTSF=+GMTSL 0  Q 1
-FST(X)	; First Component in Type
-	N GMTSF,GMTSL S GMTSF=$O(GMTSEG(0)),GMTSL=+($G(GMTSEGN))
-	Q:+GMTSF=+GMTSL 1  Q 0
-CHDR(X)	; Component Header
-	N GMTSN,GMTSH,GMTSL,GMTS S GMTSN=$$CNAM,GMTSH=$G(GMTSEGH)
-	S GMTSL=$G(GMTSEGL),GMTS="",$P(GMTS,"-",79-$L(GMTSH_GMTSL)/2)=""
-	S X=GMTS_" "_GMTSH_GMTSL_" "_GMTS Q:'$D(GMTSOBJ) X
-	S:$L(GMTSH)&($D(GMTSOBJ("COMPONENT HEADER"))) GMTSN=GMTSH
-	S:$L(GMTSL)&($L(GMTSN))&($D(GMTSOBJ("LIMITS"))) GMTSN=GMTSN_" "_GMTSL
-	S X=GMTSN Q X
-CNAM(X)	; Component Name
-	N GMTSH S GMTSH=+($P($G(GMTSEG(+($G(GMTSEGN)))),"^",2))
-	S X=$P($G(^GMT(142.1,+GMTSH,0)),"^",1) Q X
-LABEL	; Label
-	Q:'$D(GMTSOBJ("USE LABEL"))  N LABEL S LABEL=$G(GMTSOBJ("LABEL"))
-	W !,LABEL W:$L(LABEL) ! W:$D(GMTSOBJ("LABEL BLANK LINE")) !
-	Q
-LABDAT	; Label/Date
-	Q:'$D(GMTSOBJ("USE LABEL"))  N LABEL S LABEL=$G(GMTSOBJ("LABEL"))
-	I '$D(GMTSOBJ("DATE LINE")),$D(GMTSOBJ("LABEL")),$L(LABEL),$L($G(GMTSDTM)) S LABEL=LABEL_$J("",((79-$L(GMTSDTM))-$L(LABEL)))_GMTSDTM
-	I '$D(GMTSOBJ("DATE LINE")),$D(GMTSOBJ("LABEL")),'$L(LABEL),$L($G(GMTSDTM)) S LABEL="Information as of "_$G(GMTSDTM)
-	W !,LABEL W:$L(LABEL) ! W:$D(GMTSOBJ("LABEL BLANK LINE")) !
-	Q
+GMTSUP ; SLC/KER - Utilities for Paging HS           ; 01/06/2003
+ ;;2.7;Health Summary;**2,7,21,27,28,30,35,47,56,58**;Oct 20, 1995
+ ;
+ ; External References
+ ;   DBIA 10026  ^DIR
+ ;   DBIA    82  EN^XQORM
+ ;                       
+CKP ; Check page position, pause and prompt
+ Q:$D(GMTSQIT)  S GMTSNPG=0
+ K:$L($G(GMTSOBJ("LABEL"))) GMTSOBJ("REPORT HEADER")
+ I $G(GMTSWRIT)=1 D BREAK S GMTSWRIT=0
+ I +($$HF^GMTSU) D BREAK:(GMTSEGN'=$G(GMTSLCMP)) Q
+ Q:+$G(GMTSLPG)'>0&($Y'>(IOSL-GMTSLO))
+ I $E(IOST,1)="C" S:'$D(GMTSTOF) GMTSTOF=1 D CKP1
+ I '$D(GMTSQIT) W @IOF D HEADER,BREAK S GMTSNPG=1,GMTSTOF=GMTSEGN
+ I $D(GMTSQIT),(GMTSQIT]""),($D(GMTSTYP)) W @IOF D HEADER S GMTSTOF=GMTSEGN
+ Q
+CKP1 ; Help Display of Optional Components for Navigation
+ N DA,I,J,K,L,X,XQORM,Y,GMTSY,TYP,DIC
+ I $S('$D(GMTSTYP):1,$D(GMTOPT):1,1:0) N DIR S DIR(0)="E" D ^DIR K DIR S:$D(DUOUT)!(GMTSLPG) GMTSQIT="" Q
+ S TYP=GMTSTYP
+ S DIC=142,DIC(0)="MZF",X="GMTS HS ADHOC OPTION" S Y=$$TYPE^GMTSULT
+ S GMTSTYP=+Y K DIC,X,Y
+ S XQORM=GMTSTYP_";GMT(142,",XQORM(0)="1AF\+",XQORM("A")="Press <RET> to continue, ^ to exit, or select component: "
+ S XQORM("??")="D HELP^GMTSUP1" I GMTSLPG,'$D(GMTSOBJ) W:'$D(GMTSOBJE) "* END * "
+ S XQORM("S")="I $D(^GMT(142,DA(1),1,DA,0)),($P(^GMT(142.1,$P(^GMT(142,DA(1),1,DA,0),U,2),0),U,6)'=""T"")"
+ D EN^XQORM W ! D @$S(Y=1:"BRNCH",1:"EVAL")
+ I $D(GMTSY),(GMTSY=0) K GMTSY G CKP1
+ S GMTSTYP=TYP
+ Q
+BREAK ; Writes the Component Header
+ ;           
+ ;   If the variable GMTSOBJ exist, then the 
+ ;   Component Headers are suppressed with the
+ ;   following exceptions:
+ ;           
+ ;       If GMTSOBJ("COMPONENT HEADER") exist,
+ ;       then the Component Header will NOT be
+ ;       suppressed
+ ;           
+ ;       If GMTSOBJ("BLANK LINE") exist, a blank
+ ;       line will be written after the Component
+ ;       Header
+ ;              
+ N GMTSM,GMTSF S GMTSM=$$MUL,GMTSF=$$FST
+ I +GMTSM=0,$D(GMTSOBJ),'$D(GMTSOBJ("COMPONENT HEADER")),'$D(GMTSOBJ("BLANK LINE")) Q
+ N GMTS,GMTSUL,GMTSL S:'$D(GMTSLCMP) GMTSLCMP=0
+ S GMTSUL="",GMTSNPG=1,GMTS=$$CHDR,GMTSL=+($L($G(GMTS))),$P(GMTSUL,"-",+GMTSL)="-"
+ I $Y'>(IOSL-GMTSLO)!(+($$HF^GMTSU)) D
+ . I $D(GMTSOBJ) D  Q
+ . . S GMTSLCMP=GMTSEGN
+ . . I +($G(GMTSM))>0!($D(GMTSOBJ("COMPONENT HEADER"))) D
+ . . . W:+GMTSF=0 ! W !,GMTS W:$D(GMTSOBJ("UNDERLINE")) !,GMTSUL
+ . . . W ! W:$D(GMTSOBJ("BLANK LINE")) !
+ . W !,GMTS,!
+ . W:$Y'>(IOSL-GMTSLO) ?34,$S(GMTSEGN=GMTSLCMP:"(continued)",1:""),!
+ . S GMTSLCMP=GMTSEGN
+ Q
+OLDB ;
+ S:'$D(GMTSLCMP) GMTSLCMP=0
+ S GMTS="",GMTSNPG=1
+ S $P(GMTS,"-",79-$L(GMTSEGH_GMTSEGL)/2)=""
+ S GMTS=GMTS_" "_GMTSEGH_GMTSEGL_" "_GMTS
+ I $Y'>(IOSL-GMTSLO)!(+($$HF^GMTSU)) D
+ . W !,GMTS,!
+ . W:$Y'>(IOSL-GMTSLO) ?34,$S(GMTSEGN=GMTSLCMP:"(continued)",1:""),!
+ . S GMTSLCMP=GMTSEGN
+        Q
+HEADER ; Print Running Header
+ ;           
+ ;   If the variable GMTSOBJ exist, then the 
+ ;   Report Headers are suppressed with the 
+ ;   following exceptions:
+ ;           
+ ;       If GMTSOBJ("DATE LINE") exist, then the
+ ;       Location/Report Date line will NOT be
+ ;       suppressed.
+ ;           
+ ;       If GMTSOBJ("CONFIDENTIAL") exist, then
+ ;       the Confidential Header Name line will
+ ;       NOT be suppressed.
+ ;           
+ ;       If GMTSOBJ("REPORT HEADER") exist, then
+ ;       the Report Header containing the patient's
+ ;       name, SSAN, ward and DOB will NOT be
+ ;       suppressed.
+ ;              
+ ;       If the variable GMTSOBJ("LABEL") contains
+ ;       text, and the variable GMTSOBJ("USE LABEL")
+ ;       exist, then this text will be printed before
+ ;       the object text.
+ ;                 
+ ;       If GMTSOBJ("REPORT DECEASED") exist, then
+ ;       the optional line that displays for Deceased
+ ;       patients will NOT be suppressed.
+ ;                 
+ ;   Header Lines:
+ N GMTSVDT,DATA S DATA="" I +$G(GMTSPXD1)&+$G(GMTSPXD2) D
+ . Q:$G(GMTSOBJ)  S:'$D(GMTSOBJE) DATA="Printed for data "  S:$D(GMTSOBJE) DATA="Include data "
+ . I GMTSPXD1=GMTSPXD2 S DATA=DATA_"on "_GMTSPXD1 Q
+ . S DATA=DATA_"from "_GMTSPXD2_" to "_GMTSPXD1
+ I $D(GMTSCDT(0)),'$D(GMTSOBJ) S GMTSVDT=GMTSCDT(0) S:GMTSDTM'["Printed:" GMTSDTM="Printed: "_GMTSDTM
+ ;     Location and Date of Report
+ I '$D(GMTSOBJ)!($D(GMTSOBJ("DATE LINE"))) D
+ . N GMTSLOC S GMTSLOC=$S('$D(GMTSOBJ("DATE LINE")):$P($G(GMTSSC),U,2),1:"")
+ . W !,$S($L(GMTSLOC):"Location: "_GMTSLOC_" ",1:"")
+ . W $S($D(GMTSVDT):GMTSVDT,1:"")
+ . W:'$D(GMTSOBJ("DATE LINE")) DATA,?(79-$L(GMTSDTM)),GMTSDTM
+ . W:$D(GMTSOBJ("DATE LINE")) DATA,?(74-$L(GMTSDTM)),GMTSDTM
+ ;     Confidential Header Name
+ S:'$D(GMTSPG) GMTSPG=0
+ S GMTSPG=GMTSPG+1,GMTSHDR=" CONFIDENTIAL "_GMTSTITL_" SUMMARY "
+ S GMTSHDR=GMTSHDR_$S($E(IOST,1)="C":"",1:"  pg. "_GMTSPG)
+ S GMTS="" S:'$D(GMTSOBJ) $P(GMTS,"*",(77-$L(GMTSHDR))\2)="*"
+ S:$D(GMTSOBJ) $P(GMTS,"*",(72-$L(GMTSHDR))\2)="*"
+ S GMTSHDR=GMTS_" "_GMTSHDR_" "_GMTS
+ I '$D(GMTSOBJ)!($D(GMTSOBJ("CONFIDENTIAL"))) W !,GMTSHDR,"*"
+ ;     Name, SSAN, Ward, DOB
+ I '$D(GMTSLFG) D
+ . I $G(GMTSPHDR("TWO")) D
+ . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")),$L($G(GMTSOBJ("LABEL"))) D LABEL
+ . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")) Q
+ . . W !,GMTSPHDR("NMSSN"),?GMTSPHDR("DOBS"),GMTSPHDR("DOB")
+ . . W !,?GMTSPHDR("WARDRBS"),GMTSPHDR("WARDRB")
+ . E  D
+ . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")),$L($G(GMTSOBJ("LABEL"))) D LABEL
+ . . I $D(GMTSOBJ),'$D(GMTSOBJ("REPORT HEADER")) Q
+ . . W !,GMTSPHDR("NMSSN"),?GMTSPHDR("WARDRBS")
+ . . W GMTSPHDR("WARDRB"),?GMTSPHDR("DOBS"),GMTSPHDR("DOB")
+ ;     Deceased
+ ;                    
+ I '$D(GMTSOBJ)!($D(GMTSOBJ("DECEASED"))) D
+ . W:+$G(VADM(6)) !,?26,"** DECEASED   "_$P(VADM(6),U,2)_" **"
+ W:'$D(GMTSOBJ) !
+ Q
+BRNCH ; Checks abbreviation to branch to a different component
+ N GMTINX,LIM,CREC,SBS
+ I Y,("+-"[X) S:X="-" GMTSEGN=GMTSTOF-1 S (GMTSY,GMTSQIT)=1,GMTSLPG=0 Q
+ I X="^^" S DIROUT=1,GMTSQIT="" Q
+ I Y,(X?1"^^".E) Q
+ S GMTINX=$S($D(^GMT(142,GMTSTYP,1,+Y(1),0)):$P(^(0),U,2),1:"")
+ I 'GMTINX S GMTSY=0 Q
+ I '$D(GMTSEGI(GMTINX)) N GMI,GMJ,GMTSDFLT S GMI=1,GMJ=GMTSEGC,GMTSDFLT=1 D LOAD^GMTSADH S GMTSEGC=GMTSEGC+1
+ I '$D(GMTSEGI(GMTINX)) S GMTINX="",GMTSY=0 Q
+ S LIM=$P(Y(1),U,4) I LIM'["=" G NOLIM
+ S CREC=^GMT(142.1,GMTINX,0),SBS=GMTSEGI(GMTINX) D CMPLIM^GMTSADH2
+ I $D(DIROUT) S GMTSQIT="" Q
+NOLIM ; No limits
+ S GMTSEGN=GMTSEGI(GMTINX)-1,(GMTSY,GMTSQIT)=1,GMTSLPG=0
+ Q
+ ;
+EVAL ; Evaluate input to determine quit or continue
+ Q:'$D(X)
+ S:$D(GMTSEXIT) GMTSEXIT=$G(X)
+ S:$D(DTOUT) DIROUT=1 I $S(X="^^":1,GMTSLPG:1,$D(DIROUT):1,X="^":1,1:0) S GMTSQIT=""
+ I +$G(GMPSAP),(X="^") S GMDUOUT=1
+ Q
+MUL(X) ; Multiple Components in Type
+ N GMTSF,GMTSL S GMTSF=$O(GMTSEG(0)),GMTSL=$O(GMTSEG(" "),-1)
+ Q:+GMTSF=+GMTSL 0  Q 1
+FST(X) ; First Component in Type
+ N GMTSF,GMTSL S GMTSF=$O(GMTSEG(0)),GMTSL=+($G(GMTSEGN))
+ Q:+GMTSF=+GMTSL 1  Q 0
+CHDR(X) ; Component Header
+ N GMTSN,GMTSH,GMTSL,GMTS S GMTSN=$$CNAM,GMTSH=$G(GMTSEGH)
+ S GMTSL=$G(GMTSEGL),GMTS="",$P(GMTS,"-",79-$L(GMTSH_GMTSL)/2)=""
+ S X=GMTS_" "_GMTSH_GMTSL_" "_GMTS Q:'$D(GMTSOBJ) X
+ S:$L(GMTSH)&($D(GMTSOBJ("COMPONENT HEADER"))) GMTSN=GMTSH
+ S:$L(GMTSL)&($L(GMTSN))&($D(GMTSOBJ("LIMITS"))) GMTSN=GMTSN_" "_GMTSL
+ S X=GMTSN Q X
+CNAM(X) ; Component Name
+ N GMTSH S GMTSH=+($P($G(GMTSEG(+($G(GMTSEGN)))),"^",2))
+ S X=$P($G(^GMT(142.1,+GMTSH,0)),"^",1) Q X
+LABEL ; Label
+ Q:'$D(GMTSOBJ("USE LABEL"))  N LABEL S LABEL=$G(GMTSOBJ("LABEL"))
+ W !,LABEL W:$L(LABEL) ! W:$D(GMTSOBJ("LABEL BLANK LINE")) !
+ Q
+LABDAT ; Label/Date
+ Q:'$D(GMTSOBJ("USE LABEL"))  N LABEL S LABEL=$G(GMTSOBJ("LABEL"))
+ I '$D(GMTSOBJ("DATE LINE")),$D(GMTSOBJ("LABEL")),$L(LABEL),$L($G(GMTSDTM)) S LABEL=LABEL_$J("",((79-$L(GMTSDTM))-$L(LABEL)))_GMTSDTM
+ I '$D(GMTSOBJ("DATE LINE")),$D(GMTSOBJ("LABEL")),'$L(LABEL),$L($G(GMTSDTM)) S LABEL="Information as of "_$G(GMTSDTM)
+ W !,LABEL W:$L(LABEL) ! W:$D(GMTSOBJ("LABEL BLANK LINE")) !
+ Q