- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP5D.m
r613 r623 1 GMRCP5D 2 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,15,22,29,35,38,61**;Dec 27, 1997;Build 2 3 4 FORMAT(GMRCIFN,GMRCRD,PAGEWID) 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 ADDEND(GMRCIFN,GMRCR0,GMRCNDX,GMRCRD,PAGEWID) 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 HDR 107 108 109 110 111 112 113 114 115 116 117 118 119 120 .D BLD("HDR",PG,1,55,"|Consult No.: "_GMRCIFN)121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 CENTER(X) 154 155 156 157 158 159 160 BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) 161 162 163 164 165 166 167 168 169 170 171 172 173 SUB(ZONE,SUB,NDX,TEXT) 174 175 176 177 178 179 180 LASTLN(SUB,NDX) 181 182 183 CONSRQ(IFN) 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 EXDT(X) 199 200 201 202 203 204 1 GMRCP5D ;SLC/DCM,RJS,JFR - Print Consult form 513 (Gather Data - Addendums, Headers, Service reports and Comments) ;8/19/03 15:31 2 ;;3.0;CONSULT/REQUEST TRACKING;**4,12,15,22,29,35,38**;Dec 27, 1997 3 ; 4 FORMAT(GMRCIFN,GMRCRD,PAGEWID) ; 5 ; 6 I $L($P(GMRCRD,U,15)) D 7 .I $O(^TMP("GMRCR",$J,"MCAR",0)) D 8 ..N GMRCSVC 9 ..S GMRCSVC=$P($G(^GMR(123.5,+$P(GMRCRD,U,5),0)),U,1) 10 ..S:$L(GMRCSVC) GMRCSVC=GMRCSVC_" " 11 ..; 12 ..; Medicine Results? 13 ..S GMRCR0=0 F S GMRCR0=$O(^TMP("GMRCR",$J,"MCAR",GMRCR0)) Q:'GMRCR0 D 14 ...D SUB("H","SREP",GMRCR0,$$CENTER(GMRCSVC_"Service Report #"_GMRCR0_" continued.")) 15 ...D SUB("H","SREP",GMRCR0," ") 16 ...D BLD("SREP",GMRCR0,1,0,$$CENTER("Medicine Package Report")) 17 ...D BLD("SREP",GMRCR0,1,0,"") 18 ...N LN 19 ...S LN=0 F S LN=$O(^TMP("GMRCR",$J,"MCAR",GMRCR0,LN)) Q:'LN D 20 ....D BLD("SREP",GMRCR0,1,0,$G(^TMP("GMRCR",$J,"MCAR",GMRCR0,LN,0))) 21 ; 22 ; Build Processing Activities 23 S GMRCR0=0 F S GMRCR0=$O(^GMR(123,GMRCIFN,40,GMRCR0)) Q:'GMRCR0 D 24 .N GMRCR1,GMRC400,CMT,USER,GMRCDT,RPRV,GMRC402,GMRCISIT 25 .S GMRCR1=+$O(^GMR(123,GMRCIFN,40,GMRCR0,0)) Q:GMRCR1'=1 26 .S GMRC400=$G(^GMR(123,GMRCIFN,40,GMRCR0,0)) 27 .S GMRC402=$G(^GMR(123,GMRCIFN,40,GMRCR0,2)) 28 .S CMT=$$PRCMT^GMRCP5B(+$P(GMRC400,U,2)) Q:'$L(CMT) 29 .S GMRCDT=$P(GMRC400,U,3) S:'GMRCDT GMRCDT=$P(GMRC400,U,1) 30 .S GMRCDT=$$EXDT(GMRCDT)_" "_$P(GMRC402,U,3) 31 .;Following lines modified in patch *38 32 .;I $P(^GMR(123,GMRCIFN,0),U,23) D ;commented out 33 .;.S GMRCISIT=$$GET1^DIQ(4,$P(^GMR(123,GMRCIFN,0),U,23),.01) ;commented out 34 .;.S GMRCISIT="Entered at: "_GMRCISIT ;commented out 35 .I $L(GMRC402) D ;ADDED 36 ..S GMRCISIT=$$GET1^DIQ(123,GMRCIFN,.07) ;ADDED 37 .I '$D(GMRCISIT) D ;ADDED 38 ..S GMRCISIT=$$KSP^XUPARAM("INST") ;ADDED 39 ..I GMRCISIT'="" S GMRCISIT=$$GET1^DIQ(4,GMRCISIT,.01) ;ADDED 40 ..I GMRCISIT="" S GMRCISIT=$$GET1^DIQ(123,GMRCIFN,.05) ;ADDED 41 .S GMRCISIT="Entered at: "_GMRCISIT ;ADDED 42 .;End of modifications for patch *38 43 .S RPRV=$$GET1^DIQ(200,+$P(GMRC400,U,4),.01) 44 .I '$L(RPRV) S RPRV=$P(GMRC402,U,2) 45 .S:($L(RPRV)) RPRV="Responsible Person: "_RPRV 46 .S USER=$$GET1^DIQ(200,+$P(GMRC400,U,5),.01) 47 .I '$L(USER) S USER=$P(GMRC402,U) 48 .S USER="Entered by: "_USER_" - "_GMRCDT 49 .D SUB("H","COM",GMRCR0,CMT_" Comment ("_USER_") continued.") 50 .D SUB("H","COM",GMRCR0," ") 51 .D BLD("COM",GMRCR0,1,0,"") 52 .D BLD("COM",GMRCR0,1,0,$$CENTER("("_CMT_" Comment)")) 53 .I $P(GMRC400,U,2)=17!($P(GMRC400,U,2)=25) D 54 .. N FWDLN,FWDRS 55 .. S FWDLN="Forwarded from: " 56 .. S FWDRS=$P($G(^GMR(123,GMRCIFN,40,GMRCR0,3)),U) 57 .. I $L(FWDRS) S FWDLN=FWDLN_FWDRS 58 .. I '$L(FWDRS) S FWDLN=FWDLN_$$GET1^DIQ(123.5,+$P(GMRC400,U,6),.01) 59 .. D BLD("COM",GMRCR0,1,5,FWDLN) 60 .D BLD("COM",GMRCR0,1,5,USER) 61 .D:($L(RPRV)) BLD("COM",GMRCR0,1,5,RPRV) 62 .D:($L($G(GMRCISIT))) BLD("COM",GMRCR0,1,5,GMRCISIT) 63 .; 64 .N GMRCR2 S GMRCR2=0 65 .F S GMRCR2=$O(^GMR(123,GMRCIFN,40,GMRCR0,GMRCR1,GMRCR2)) Q:'GMRCR2 D 66 ..D BLD("COM",GMRCR0,1,0,$G(^GMR(123,GMRCIFN,40,GMRCR0,GMRCR1,GMRCR2,0))) 67 ; 68 Q 69 ; 70 ADDEND(GMRCIFN,GMRCR0,GMRCNDX,GMRCRD,PAGEWID) ; 71 ; 72 N GMRCADD,GMRCNDX,GMRCR1,GMRCV,TEXT,GMRCX 73 ; 74 S GMRCADD=0 F S GMRCADD=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD)) Q:'GMRCADD D 75 .N GMRCSGNM,GMRCNMDT,GMRCTIT,GMRCMODE,GMRCCSDT,GMRCCTIT,GMRCCSGM 76 .; 77 .F GMRCV="GMRCSGNM","GMRCNMDT","GMRCTIT","GMRCMODE" D 78 ..S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCV)) 79 .; 80 . F GMRCV="GMRCCSDT","GMRCCTIT","GMRCCSGM","GMRCCSIG" D 81 .. S @GMRCV=$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCV)) 82 .S GMRCNDX=$O(^TMP("GMRC",$J,"OUTPUT","RES"," "),-1)+1 83 .I $L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Addendum #"_GMRCADD_" To Consult Note #"_GMRCR0_" for "_GMRCRPT_" continued.") 84 .I '$L($G(GMRCRPT)) D SUB("H","RES",GMRCNDX,"Addendum #"_GMRCADD_" To Consult Note #"_GMRCR0_" continued.") 85 .D SUB("H","RES",GMRCNDX," ") 86 .I $L($G(GMRCSGNM)) D 87 ..D SUB("F","RES",GMRCNDX," ") 88 ..I (GMRCMODE="electronic") S GMRCX=" Addendum Signature: "_GMRCSGNM_" /es/ "_$$EXDT($G(GMRCNMDT)) 89 ..I '(GMRCMODE="electronic") S GMRCX=" Addendum Author: "_GMRCSGNM S:$L($G(GMRCNMDT)) GMRCX=GMRCX_" Last edited: "_$$EXDT(GMRCNMDT) 90 ..D SUB("F","RES",GMRCNDX,GMRCX) 91 ..D:$L($G(GMRCTIT)) SUB("F","RES",GMRCNDX," "_GMRCTIT) 92 .I $L($G(GMRCCSDT)) D 93 ..D SUB("F","RES",GMRCNDX," ") 94 ..I (GMRCCSGM="electronic") S GMRCX=" Addendum CoSignature: "_GMRCCSIG_" /es/ "_$$EXDT(GMRCCSDT) 95 ..I '(GMRCCSGM="electronic") S GMRCX=" Addendum CoSignature: "_GMRCCSIG_" /chart/ "_$$EXDT(GMRCCSDT) 96 ..D SUB("F","RES",GMRCNDX,GMRCX) 97 ..D:$L($G(GMRCCTIT)) SUB("F","RES",GMRCNDX," "_GMRCCTIT) 98 .D BLD("RES",GMRCNDX,1,0," ") 99 .I $L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("ADDENDUM #"_GMRCADD_" TO CONSULT NOTE #"_GMRCR0_" FOR "_GMRCRPT)) 100 .I '$L($G(GMRCRPT)) D BLD("RES",GMRCNDX,1,0,$$CENTER("ADDENDUM #"_GMRCADD_" TO CONSULT NOTE #"_GMRCR0)) 101 .D BLD("RES",GMRCNDX,1,0," ") 102 .S GMRCR1=0 F S GMRCR1=$O(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCR1)) Q:'GMRCR1 D 103 ..D BLD("RES",GMRCNDX,1,0,$G(^TMP("GMRCR",$J,"RES",GMRCR0,"ADD",GMRCADD,GMRCR1,0))) 104 Q 105 ; 106 HDR ; Header code for form 513 107 ; 108 N PG,GMRCFROM 109 ; 110 F PG=0,1 D 111 .D BLD("HDR",PG,1,0,GMRCDVL) 112 .D BLD("HDR",PG,1,6,"MEDICAL RECORD") 113 .D BLD("HDR",PG,0,29,"|") 114 .D BLD("HDR",PG,0,36,"CONSULTATION SHEET") 115 .I PG D BLD("HDR",PG,0,60,"Page ","GMRCPG,65") I 1 116 .E I '$G(GMRCGUI) D BLD("HDR",PG,0,60,"Page ","GMRCPG,65") 117 .; 118 .D BLD("HDR",PG,1,0,GMRCDVL) 119 .D BLD("HDR",PG,1,0,"Consult Request: "_$$CONSRQ(GMRCIFN)) 120 .D BLD("HDR",PG,0,55,"|Consult No.: "_GMRCIFN) 121 .; 122 D BLD("HDR",1,1,0,GMRCEQL) 123 D BLD("HDR",0,1,0,GMRCDVL) 124 ; 125 I $G(CMT) D BLD("HDR",0,1,27,"("_$$PRCMT^GMRCP5B(CMT)_")") Q 126 ; 127 S GMRCFROM=$P($G(^SC(+$P(GMRCRD,U,6),0)),U,1) 128 ; 129 I '$L(GMRCFROM) D 130 .N VAIN 131 .D INP^VADPT 132 .S GMRCFROM=$P($G(VAIN(4)),U,2) 133 .I $L($G(VAIN(5))) S GMRCFROM=GMRCFROM_" (Rm/Bd: "_$G(VAIN(5))_" )" 134 ;No location, IFC - consulting site 135 I '$L(GMRCFROM),$P(GMRCRD,U,23),$P($G(GMRCRD(12)),U,5)="F" D 136 .I $P(GMRCRD,U,21) S GMRCFROM=$$GET1^DIQ(4,$P(GMRCRD,U,21),.01) 137 .E S GMRCFROM=$$GET1^DIQ(4,$P(GMRCRD,U,23),.01) 138 ; 139 D BLD("HDR",0,1,0,"To: "_$P($G(^GMR(123.5,+$P(GMRCRD,U,5),0)),U,1)) 140 D BLD("HDR",0,1,5,"From: "_GMRCFROM) 141 D BLD("HDR",0,0,49,"|Requested: "_$$EXDT($P(GMRCRD,U,7))) 142 ; 143 D BLD("HDR",0,1,0,GMRCDVL) 144 D BLD("HDR",0,1,0,"Requesting Facility: "_$E(GMRCFAC,1,22)) 145 I $P(GMRCRD,U,11) D BLD("HDR",0,0,45,"|ATTENTION: "_$E($P($G(^VA(200,+$P(GMRCRD,U,11),0)),U,1),1,21)) 146 I $P(GMRCRD,U,23) D 147 . D BLD("HDR",0,1,0,"Remote Consult No.: "_GMRCINO) 148 . D BLD("HDR",0,1,0,"Role: "_GMRCIRL) 149 D BLD("HDR",0,1,0,GMRCEQL) 150 ; 151 Q 152 ; 153 CENTER(X) ; 154 ; 155 N TEXT,COL 156 S COL=35-($L(X)\2) Q:(COL<1) X 157 S $E(TEXT,COL)=X 158 Q TEXT 159 ; 160 BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) ; 161 ; 162 Q:'$L($G(SUB)) 163 N LINECNT 164 ; 165 F LINECNT=1:1:+LINE S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX)+1,0)="" 166 ; 167 S $E(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),0),TAB+1)=TEXT 168 I $L($G(RUNTIME)) S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),1)=RUNTIME 169 ; 170 S GMRCLAST=SUB 171 Q 172 ; 173 SUB(ZONE,SUB,NDX,TEXT) ; 174 ; 175 N NEXT 176 S NEXT=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE," "),-1)+1 177 S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,NEXT,0)=TEXT 178 Q 179 ; 180 LASTLN(SUB,NDX) ; 181 Q +$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1) 182 ; 183 CONSRQ(IFN) ; 184 ; 185 N PTR,LINK,REF,GMRCRQ 186 I +$P(^GMR(123,+IFN,0),U,8) D 187 . S GMRCRQ=$P(^GMR(123,+IFN,0),U,8) 188 . S GMRCRQ=$$GET1^DIQ(123.3,+GMRCRQ,.01) 189 . I '$L(GMRCRQ) S GMRCRQ="Procedure" 190 I $L($G(GMRCRQ)) Q GMRCRQ 191 I $L($G(^GMR(123,IFN,1.11))) D 192 . N SERV,TYPE 193 . S SERV=$$UP^XLFSTR($$GET1^DIQ(123.5,$P(^GMR(123,IFN,0),U,5),.01)) 194 . S TYPE=$$UP^XLFSTR(^GMR(123,IFN,1.11)) I TYPE'=SERV D 195 . I TYPE'=SERV S GMRCRQ=$E(^GMR(123,IFN,1.11),1,36) 196 Q:$L($G(GMRCRQ)) GMRCRQ Q "Consult" 197 ; 198 EXDT(X) ;EXTERNAL DATE FORMAT 199 ; 200 N DATE,TIME,HR,MN,PD,Y,%DT 201 Q:'$L(X) "" 202 I '(X?7N.1".".6N) S %DT="PTS" D ^%DT S X=Y 203 Q $$FMTE^XLFDT(X,"5PMZ") 204 ;
Note:
See TracChangeset
for help on using the changeset viewer.
