| [613] | 1 | GMTSU ; SLC/JER,KER/NDBI - Health Summary Utilities ; 08/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**27,28,31,35,37,43,47,56**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10096 ^%ZOSF("TEST")
|
|---|
| 6 | ; DBIA 2934 ^A7RCP (NDBI Global)
|
|---|
| 7 | ; DBIA 10103 $$FMTE^XLFDT
|
|---|
| 8 | ; DBIA 10103 $$FMTHL7^XLFDT
|
|---|
| 9 | ; DBIA 10103 $$HL7TFM^XLFDT
|
|---|
| 10 | ; DBIA 10061 OERR^VADPT
|
|---|
| 11 | ; DBIA 10104 $$UP^XLFSTR
|
|---|
| 12 | ; DBIA 10026 ^DIR
|
|---|
| 13 | ; DBIA 2052 FILE^DID
|
|---|
| 14 | ; DBIA 10022 %XY^%RCR
|
|---|
| 15 | ; DBIA 2055 $$VFIELD^DILFD
|
|---|
| 16 | ; DBIA 2052 $$GET1^DID
|
|---|
| 17 | ;
|
|---|
| 18 | PROK(X,Y) ; Routine and Patch # OK (in UCI)
|
|---|
| 19 | N GMTS,GMTSI,GMTSO S X=$G(X),Y=$G(Y) Q:'$L(X) 0 Q:Y'=""&(+Y=0)
|
|---|
| 20 | S Y=+Y,GMTS=$$ROK(X) Q:'GMTS 0 Q:+Y=0 1 S GMTSO=0,GMTS=$T(@("+2^"_X)),GMTS=$P($P(GMTS,"**",2),"**",1)
|
|---|
| 21 | F GMTSI=1:1:$L(GMTS,",") S:+($P(GMTS,",",GMTSI))=Y GMTSO=1 Q:GMTSO=1
|
|---|
| 22 | S X=GMTSO Q X
|
|---|
| 23 | ROK(X) ; Routine OK (in UCI) (NDBI)
|
|---|
| 24 | S X=$G(X) Q:'$L(X) 0 Q:$L(X)>8 0 X ^%ZOSF("TEST") Q:$T 1 Q 0
|
|---|
| 25 | NDBI(X) ; National Database Integration site 1 = yes 0 = no
|
|---|
| 26 | N R,G S X="A7RDUP" X ^%ZOSF("TEST") S R=$T,G=$S($D(^A7RCP):1,1:0),X=R+G,X=$S(X=2:1,1:0) Q X
|
|---|
| 27 | ;
|
|---|
| 28 | CPT(X) ; Use CPT Modifiers Needs GMTSEG Array
|
|---|
| 29 | S X=+($G(X)) N GMTSN,GMTSC,GMTSM,GMTSA,GMTSI S GMTSN=$G(GMTSEG(X)) S GMTSC=+($P(GMTSN,"^",2)) Q:'GMTSC 0
|
|---|
| 30 | S GMTSM=$S($P(GMTSN,"^",9)="N":0,$P(GMTSN,"^",9)="":1,1:1) Q:'GMTSM 0
|
|---|
| 31 | S GMTSA=$S(+($$CMU(+GMTSC))>0:1,1:0) Q:'GMTSA 0
|
|---|
| 32 | Q 1
|
|---|
| 33 | CMU(X) ; Component Uses CPT Modifiers
|
|---|
| 34 | N GMTSA,GMTSN,GMTSI S X=$G(X) Q:'$L(X) 0 S GMTSI=+X,GMTSA=$O(^GMT(142.1,"C",X,0)),GMTSN=$O(^GMT(142.1,"D",X,0)) S:GMTSI=0&(+GMTSA>0) GMTSI=GMTSA S:GMTSI=0&(+GMTSN>0) GMTSI=GMTSN
|
|---|
| 35 | Q:+GMTSI=0 0 S GMTSA=$S($P($G(^GMT(142.1,+GMTSI,0)),"^",14)="Y":1,1:0) Q:'GMTSA 0
|
|---|
| 36 | Q 1
|
|---|
| 37 | ;
|
|---|
| 38 | ; Dates and Time
|
|---|
| 39 | ED(X) ; Health Summary External Date
|
|---|
| 40 | S X=$G(X) Q:'$L(X) "" D REGDT4 Q X
|
|---|
| 41 | EDT(X) ; Health Summary External Date and Time
|
|---|
| 42 | S X=$G(X) Q:'$L(X) "" D REGDTM4 Q X
|
|---|
| 43 | REGDT ; Receives X FM date and returns X in MM/DD/YY format
|
|---|
| 44 | S X=$TR($$FMTE^XLFDT(X,"2DZ"),"@"," ") Q
|
|---|
| 45 | REGDT4 ; Receives X FM date and returns X in MM/DD/YYYY format
|
|---|
| 46 | S X=$TR($$FMTE^XLFDT(X,"5DZ"),"@"," ") Q
|
|---|
| 47 | REGDTM ; Receives X FM date and returns X in MM/DD/YY TT:TT
|
|---|
| 48 | S X=$TR($$FMTE^XLFDT(X,"2ZM"),"@"," ") Q
|
|---|
| 49 | REGDTM4 ; Receives X FM date and returns X in MM/DD/YYYY TT:TT
|
|---|
| 50 | S X=$TR($$FMTE^XLFDT(X,"5ZM"),"@"," ") Q
|
|---|
| 51 | SIDT ; Receives X FM date and returns X in DD MMM YY
|
|---|
| 52 | N MON,MM S X=$P(X,".") S:'X X="" Q:'$L(X)
|
|---|
| 53 | S MON="JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"
|
|---|
| 54 | S MM=$E(X,4,5),MM=$S(MM:$P(MON,U,+MM),1:"")
|
|---|
| 55 | S X=$E(X,6,7)_" "_MM_" "_$E(X,2,3) Q
|
|---|
| 56 | MTIM ; Convert Time from X=2890313.1304 to X=13:04
|
|---|
| 57 | S X=$P(X,".",2) Q:'$L(X) S X=$S(X:$E(X,1,2)_$E("00",0,2-$L($E(X,1,2)))_":"_$E(X,3,4)_$E("00",0,2-$L($E(X,3,4))),1:"")
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | HF(X) ; Host File - Used to distinguish from Host Files that
|
|---|
| 61 | ; are intended for Printers and Host Files for other
|
|---|
| 62 | ; purposes (windows/files)
|
|---|
| 63 | ;
|
|---|
| 64 | ; 1 - if Device Type is HFS and not a TCP/IP Printer
|
|---|
| 65 | ; 0 - if Device Type is not HFS or device is a Printer
|
|---|
| 66 | ;
|
|---|
| 67 | ; Check Device
|
|---|
| 68 | ; Check Host File Server
|
|---|
| 69 | Q:$G(IOT)'="HFS" 0
|
|---|
| 70 | ; Check ORWINDEV (Post OR*3.0*85)
|
|---|
| 71 | N GMTS85 S GMTS85=$$PROK("ORWRP",85)
|
|---|
| 72 | Q:+($G(GMTS85))>0&(+($G(ORWINDEV))>0) 0
|
|---|
| 73 | ; Host File for GUI Scrollable Window
|
|---|
| 74 | Q:$E($G(ION),1,14)["OR WORKSTATION" 1
|
|---|
| 75 | ; TCP/IP Printer
|
|---|
| 76 | Q:$G(IO)["$PRT"!($G(IO)["PRN|") 0
|
|---|
| 77 | ; Windows Printer
|
|---|
| 78 | Q:$E($G(ION),1,14)["OR WINDOWS HFS" 0
|
|---|
| 79 | ; Host Files (file or unspecifed printer)
|
|---|
| 80 | S X=0 S:$G(ION)["HOST FILE" X=1
|
|---|
| 81 | S:$E($G(IOST),1,5)["P-OTH" X=1
|
|---|
| 82 | Q X
|
|---|
| 83 | ;
|
|---|
| 84 | FMHL7DTM ; Convert X - int date/time to HL7 CCYYMMDDHHMM-HHHH
|
|---|
| 85 | S X=$$FMTHL7^XLFDT(+($G(X))) Q
|
|---|
| 86 | HL7FMDTM ; Convert X - HL7 CCYYMMDDHHMM-HHHH to int date/time local
|
|---|
| 87 | S X=$$HL7TFM^XLFDT($G(X),"L") Q
|
|---|
| 88 | ;
|
|---|
| 89 | DEM ; Gets Demographic Data from VADPT
|
|---|
| 90 | ;
|
|---|
| 91 | ; Input DFN
|
|---|
| 92 | ;
|
|---|
| 93 | ; Output GMTSPNM Patient Name
|
|---|
| 94 | ; GMTSSN Social Security Number
|
|---|
| 95 | ; GMTSDOB Date of Birth
|
|---|
| 96 | ; SEX Sex
|
|---|
| 97 | ; GMTSWARD Ward
|
|---|
| 98 | ; GMTSRB Bed
|
|---|
| 99 | ; GMTSAGE Age
|
|---|
| 100 | ; VADM() Demographic Array
|
|---|
| 101 | ; VAIN() Inpatient Array
|
|---|
| 102 | ; GMTSPHDR() Report Header Array
|
|---|
| 103 | ;
|
|---|
| 104 | K VAHOW D OERR^VADPT S GMTSPNM=VADM(1),GMTSSN=$S($D(VA("PID")):VA("PID"),1:$P(VADM(2),"^",2))
|
|---|
| 105 | S GMTSAGE=$S(+VADM(4)>0:+VADM(4),1:99),SEX=$P(VADM(5),"^")
|
|---|
| 106 | S GMTSWARD=$P(VAIN(4),"^",2),GMTSRB=VAIN(5)
|
|---|
| 107 | S X=$P(VADM(3),"^") D REGDT4 S GMTSDOB=X K VA,GMTSPHDR N DOB,LWARDRB,NMSSN,NMSSNE,WARDRB,WARDRBE,WARDRBS
|
|---|
| 108 | S NMSSN=GMTSPNM_" "_GMTSSN,NMSSNE=$L(NMSSN)+2,WARDRB=GMTSWARD_" "_GMTSRB
|
|---|
| 109 | S LWARDRB=$L(WARDRB),WARDRBS=40-(LWARDRB/2),WARDRBE=WARDRBS+LWARDRB
|
|---|
| 110 | S DOB="DOB: "_GMTSDOB,GMTSPHDR("NMSSN")=NMSSN,GMTSPHDR("WARDRB")=WARDRB
|
|---|
| 111 | S GMTSPHDR("WARDRBS")=WARDRBS,GMTSPHDR("DOB")=DOB,GMTSPHDR("DOBS")=64
|
|---|
| 112 | I (NMSSNE'<WARDRBS)!(WARDRBE'<64) S GMTSPHDR("TWO")=1
|
|---|
| 113 | Q
|
|---|
| 114 | ;
|
|---|
| 115 | NAME(X,Y,L) ; Format name
|
|---|
| 116 | ;
|
|---|
| 117 | ; Input
|
|---|
| 118 | ; X Internal Entry Number of NEW PERSON file 200
|
|---|
| 119 | ; Y Flag to specify the first name format
|
|---|
| 120 | ; 0 for First Name Initial (only)
|
|---|
| 121 | ; 1 for First Name
|
|---|
| 122 | ; L Maximum Length of Name
|
|---|
| 123 | ;
|
|---|
| 124 | ; Output Last,First (name/initial) to specified length
|
|---|
| 125 | ;
|
|---|
| 126 | N RAWNM,LAST,FIRST,ALPHA,PSN,CH,IEN,FNF,LEN
|
|---|
| 127 | S IEN=+($G(X)),FNF=+($G(Y)),LEN=+($G(L))
|
|---|
| 128 | S RAWNM=$$UNAM^GMTSU2(+IEN) S:LEN=0 LEN=$L(RAWNM)
|
|---|
| 129 | S RAWNM=$S($L(RAWNM):RAWNM,1:"UNKNOWN")
|
|---|
| 130 | S LAST=$P(RAWNM,","),FIRST=$P(RAWNM,",",2),ALPHA=0
|
|---|
| 131 | I $L(FIRST) D
|
|---|
| 132 | . F PSN=1:1 S CH=$E(FIRST,PSN) Q:CH="" S:CH?1A ALPHA=PSN Q:ALPHA>0
|
|---|
| 133 | S:ALPHA>0 FIRST=$E(FIRST,ALPHA,$L(FIRST))
|
|---|
| 134 | S:'FNF FIRST=$E(FIRST,1)
|
|---|
| 135 | S X=$S($L(FIRST):LAST_","_FIRST,1:LAST),X=$E(X,1,LEN)
|
|---|
| 136 | Q X
|
|---|
| 137 | GETRANGE(FROMDATE,TODATE) ; Select Date Range (from and to dates)
|
|---|
| 138 | N DIR,X,Y,DTOUT,DIRUT S DIR(0)="DO^:DT",DIR("A")="Enter Beginning Date (MM/DD/YY)" W !
|
|---|
| 139 | D ^DIR I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!$D(DIRUT) W ! Q
|
|---|
| 140 | S FROMDATE=Y I +FROMDATE>0 D
|
|---|
| 141 | . W " (",$$UP^XLFSTR($$FMTE^XLFDT(+FROMDATE,1)),")"
|
|---|
| 142 | . N DIR,X,Y S DIR(0)="DO^::EX",DIR("A")="Enter Ending Date (MM/DD/YY)" S DIR("B")="TODAY"
|
|---|
| 143 | . D ^DIR I $D(DIROUT)!$D(DUOUT)!$D(DTOUT)!$D(DIRUT) K FROMDATE Q
|
|---|
| 144 | . I Y'>0 K FROMDATE Q
|
|---|
| 145 | . S TODATE=Y Q:TODATE>FROMDATE!(TODATE=FROMDATE)
|
|---|
| 146 | . N FRDT S FRDT=FROMDATE,FROMDATE=TODATE,TODATE=FRDT
|
|---|
| 147 | W !
|
|---|
| 148 | Q
|
|---|
| 149 | ;
|
|---|
| 150 | OED() ; Other Editor - DIC("S")
|
|---|
| 151 | N COMP,OTHER,OWNER,OWNN,USER,AUSER,NAT S COMP=+($G(DA(1))) Q:'$D(^GMT(142,+COMP,0)) 0
|
|---|
| 152 | S OWNER=$P($G(^GMT(142,+COMP,0)),"^",3),OWNN=$$UNAM^GMTSU2(OWNER),NAT=+($P($G(^GMT(142,+COMP,"VA")),"^",1)),USER=+($G(DUZ)),AUSER=$$UACT^GMTSU2(+USER),OTHER=+($G(X))
|
|---|
| 153 | ; If National Component and Uneditable
|
|---|
| 154 | W:+NAT=2 !!," Nationally exported Health Summary Type (uneditable)",! Q:+NAT=2 0
|
|---|
| 155 | ; If OWNER is special case (national, uneditable)
|
|---|
| 156 | W:+OWNER>0&(OWNER<1)&(NAT'=1) !!," OWNER does not allow 'OTHER EDITORS'",! Q:+OWNER>0&(OWNER<1)&(NAT'=1) 0
|
|---|
| 157 | ; If OWNER is special case (national, editable)
|
|---|
| 158 | Q:+OWNER>0&(OWNER<1)&(OWNER=USER)&(NAT=1) 1
|
|---|
| 159 | ; If DUZ is inactive, or not the owner, quit
|
|---|
| 160 | W:+AUSER=0!(+OWNER=0)!(+OWNER'=+USER) !!," Only the OWNER may assign 'OTHER EDITORS'",! Q:+AUSER=0!(+OWNER=0)!(+OWNER'=+USER) 0
|
|---|
| 161 | ; If OTHER is inactive user, quit
|
|---|
| 162 | S AUSER=$$UACT^GMTSU2(OTHER) W:+AUSER=0!(+OTHER'>.999999999) !!," Selected 'OTHER EDITOR' is not an active user",! Q:+AUSER=0!(+OTHER'>.999999999) 0
|
|---|
| 163 | ; If OTHER=OWNER, quit
|
|---|
| 164 | W:+OTHER=+OWNER !!," ",OWNN," is the OWNER",! Q:+OTHER=+OWNER 0
|
|---|
| 165 | Q 1
|
|---|
| 166 | ;
|
|---|
| 167 | FCLR(X) ; File Closed Root
|
|---|
| 168 | S X=$G(X) Q:+X=0 "" N GMTSL S GMTSL=$$FLOC(X),X=$S($E(GMTSL,$L(GMTSL))=",":$P(GMTSL,",")_")",1:$E(GMTSL,1,$L(GMTSL)-1)) Q:'$L(X) "" S:'$D(@X) X=""
|
|---|
| 169 | Q X
|
|---|
| 170 | FSFN(X) ; File/Sub-File Name
|
|---|
| 171 | N FI,FR,%X,%Y S FI=$G(X) Q:+X=0 "" N DIERR,GMTSN,GMTSE D FILE^DID(+FI,"N","NAME","GMTSN","GMTSE")
|
|---|
| 172 | S X="" S:'$D(DIERR) X=$$UP^XLFSTR($G(GMTSN("NAME"))) Q:$L(X) X
|
|---|
| 173 | K FR S %X="^DD("_+($G(FI))_",0,""NM"",",%Y="FR(" D %XY^%RCR S X=$$UP^XLFSTR($O(FR(""))) S:+X>0 X="" S:$L(X) X=X_" SUB-FILE" Q X
|
|---|
| 174 | FNAM(X) ; File Name
|
|---|
| 175 | S X=$G(X) Q:+X=0 "" N DIERR,GMTSN,GMTSE D FILE^DID(+X,"N","NAME","GMTSN","GMTSE") S X="" S:'$D(DIERR) X=$G(GMTSN("NAME")) Q X
|
|---|
| 176 | FLOC(X) ; File location
|
|---|
| 177 | S X=$G(X) Q:+X=0 "" N DIERR,GMTSN,GMTSE D FILE^DID(+X,"N","GLOBAL NAME","GMTSN","GMTSE") S X="" S:'$D(DIERR) X=$G(GMTSN("GLOBAL NAME")) Q X
|
|---|
| 178 | FHDD(X) ; File has a DD?
|
|---|
| 179 | S X=+($G(X)) Q:+($G(X))=0 0 S X=$$VFIELD^DILFD(X,.01),X=$S($L(X):1,1:0) Q X
|
|---|
| 180 | FLDN(X,Y) ; Field Name
|
|---|
| 181 | Q:+($G(X))=0!(+($G(Y))=0) "" S X=$$GET1^DID(+($G(X)),+($G(Y)),,"LABEL") Q X
|
|---|
| 182 | FLDS(X,Y) ; Field Set of Codes
|
|---|
| 183 | Q:+($G(X))=0!(+($G(Y))=0) "" Q:$$GET1^DID(+($G(X)),+($G(Y)),,"TYPE")'="SET" "" S X=$$GET1^DID(+($G(X)),+($G(Y)),,"POINTER") Q X
|
|---|
| 184 | FLDI(X,Y) ; Field Input Transform
|
|---|
| 185 | Q:+($G(X))=0!(+($G(Y))=0) "" S X=$$GET1^DID(+($G(X)),+($G(Y)),,"INPUT TRANSFORM") Q X
|
|---|
