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