GMRCP5B ;SLC/DCM,RJS - Print Consult form 513 (Gather Data - Footers, Provisional Diagnosis and Reason For Request) ;12/10/14 14:16
;;3.0;CONSULT/REQUEST TRACKING;**4,13,12,15,24,23,22,29,65,66,73,81**;Dec 27, 1997;Build 6
;
; Patch #23 add "SERVICE RENDERED AS:" to SF513
;ICRs
;GLOBALS/FILES
;;#872 PROTOCOL ^ORD(101) #2849 PROTOCOL #10035 PATIENT FILE #10040 HOSPITAL LOCATION(^SC) #10060 NEW PERSON
;ROUTINES/APIs
;;#1252 SDUTL3 #2056 $$GET1^DIQ #4156 REGISTRATION, COMBAT VETERAN STATUS #10003 %DT #10061 VADPT #10103 FMTE^XLFDT #10112 VASITE
Q
;
INIT(GMRCSG) ; Initialize the form
;
D HDR^GMRCP5D,FTR(.GMRCSG),REQUEST,PDIAG Q
;
REQUEST ;
N GMRCX
;
I $L($T(OUTPTPR^SDUTL3)) D
.S GMRCX=$P($$OUTPTPR^SDUTL3(DFN),U,2)
.D:$L(GMRCX) BLD("REQ",1,1,0,"Current Primary Care Provider: "_GMRCX)
I $L($T(OUTPTTM^SDUTL3)) D
.S GMRCX=$P($$OUTPTTM^SDUTL3(DFN),U,2)
.D:$L(GMRCX) BLD("REQ",1,1,0," Current Primary Care Team: "_GMRCX)
;
I $O(^TMP("GMRC",$J,"OUTPUT","REQ",0)) D BLD("REQ",1,1,0,"")
;
D SUB("H","REQ",1,"Reason For Request continued.")
D SUB("H","REQ",1," ")
;
D BLD("REQ",1,1,0,"REASON FOR REQUEST: (Complaints and findings)")
I '$O(^GMR(123,GMRCIFN,20,0)) D BLD("REQ",1,1,0,"") I 1
E D
.N LN S LN=0 F S LN=$O(^GMR(123,GMRCIFN,20,LN)) Q:LN="" D
..D BLD("REQ",1,1,0,^GMR(123,GMRCIFN,20,LN,0))
;
Q
PDIAG ;
;
;WAT GMRC 73
N GMRCD,GMRCCODE,GMRCDA,GMRCSYS,CODINTXT
S GMRCD="",GMRCCODE="",GMRCSYS=""
S GMRCD=$G(^GMR(123,GMRCIFN,30)) ;free txt prov diag
S GMRCCODE=$G(^GMR(123,GMRCIFN,30.1)) ;ICD code^prov diag date^coding system
S CODINTXT="("_GMRCCODE_")"
I $L(GMRCCODE)>0 D
.S GMRCSYS=$P(GMRCCODE,U,3) S GMRCSYS=$S(GMRCSYS="ICD":"ICD-9-CM",GMRCSYS="10D":"ICD-10-CM",1:"") ;coding system
.S GMRCCODE=$P(GMRCCODE,U) ;actual code
.S GMRCSYS="("_GMRCSYS_" "_$G(GMRCCODE)_")"
I GMRCD[$G(CODINTXT) D
.S GMRCD=$E(GMRCD,0,($L(GMRCD)-$L(CODINTXT)))
;
D BLD("PDIAG",1,1,0,"PROVISIONAL DIAG: "_GMRCD_$G(GMRCSYS))
;/GMRC 73
D BLD("PDIAG",1,1,0,GMRCDVL)
;
S (GMRCQSTR,GMRCPGR,GMRCIPH,GMRCQSTT)=""
;
I $S('$P(GMRCRD,U,23):1,$P(GMRCRD(12),U,5)="P":1,1:0) D
.S GMRCQSTR=$P(GMRCRD,U,14)
.S:'GMRCQSTR GMRCQSTR=$$GET1^DIQ(100,+$P(GMRCRD,U,3),1)
.S GMRCPGR=$$GET1^DIQ(200,+$G(GMRCQSTR),.137) S:'$L(GMRCPGR) GMRCPGR=$$GET1^DIQ(200,+$G(GMRCQSTR),.138)
.S GMRCIPH=$$GET1^DIQ(200,$G(GMRCQSTR),.132)
.;
.S GMRCQSTT=$$GET1^DIQ(200,+$G(GMRCQSTR),20.3)
.S:'$L(GMRCQSTT) GMRCQSTT=$$GET1^DIQ(200,+$G(GMRCQSTR),8)
.S GMRCQSTR=$$GET1^DIQ(200,+$G(GMRCQSTR),.01)
;
I $P(GMRCRD,U,23),$P(GMRCRD(12),U,5)="F" D
.S GMRCQSTR=$P(GMRCRD(12),U,6)
.S GMRCIPH=$P(GMRCRD(13),U,2)
.S GMRCPGR=$P(GMRCRD(13),U,3)
;
S GMRCIPH="(Phone: "_GMRCIPH_")"
S GMRCPGR="(Pager: "_GMRCPGR_")"
;
D BLD("PDIAG",1,1,0,"REQUESTED BY: ")
D BLD("PDIAG",1,0,35,"|PLACE:")
D BLD("PDIAG",1,0,58,"|URGENCY:")
;
D BLD("PDIAG",1,1,0,$E(GMRCQSTR,1,37))
D BLD("PDIAG",1,0,35,"|"_$E($P($G(^ORD(101,+$P(GMRCRD,U,10),0)),U,2),1,20))
D BLD("PDIAG",1,0,58,"|"_$E($P($G(^ORD(101,+$P(GMRCRD,U,9),0)),U,2),1,18))
;
I $L(GMRCQSTT) D
.D BLD("PDIAG",1,1,0,GMRCQSTT)
.D BLD("PDIAG",1,0,35,"|")
.D BLD("PDIAG",1,0,58,"|")
D BLD("PDIAG",1,1,0,GMRCPGR)
D BLD("PDIAG",1,0,35,"|SERVICE RENDERED AS:")
D BLD("PDIAG",1,0,58,"|CLINICALLY IND. DATE:") ;WAT/66/81
D BLD("PDIAG",1,0,58,"|")
S GMRCINOU=$S($P(GMRCRD,U,18)="O":"Outpatient",1:"Inpatient")
I $D(GMRCIPH)>0 D
.D BLD("PDIAG",1,1,0,GMRCIPH)
.D BLD("PDIAG",1,0,35,"|"_GMRCINOU)
E D
.D BLD("PDIAG",1,1,35,"|"_GMRCINOU)
D BLD("PDIAG",1,0,58,"|")
D BLD("PDIAG",1,0,58,"|"_$$FMTE^XLFDT($P(GMRCRD,U,24),1)) ;WAT/66/81
K GMRCINOU
;***************************************************************
D BLD("PDIAG",1,1,0,GMRCDVL)
;
Q
;
FTR(GMRCSG) ;Footer of form 513
;
N GMRCRMBD,GMRCFAC1,GMRCLOC,GMRCX,SUB,VAIN,VAPA,VAERR
;
D ADD^VADPT,INP^VADPT
;
S (GMRCLOC,GMRCRMBD)=""
S GMRCLOC=$P($G(VAIN(4)),U,2)
S GMRCRMBD=$G(VAIN(5))
S:'$L(GMRCLOC) GMRCLOC=$P($G(^SC(+$P($G(^GMR(123,+GMRCIFN,0)),U,4),0)),U,1)
;No location, IFC - consulting site
I '$L(GMRCLOC),$P(GMRCRD,U,23),$P($G(GMRCRD(12)),U,5)="F" D
.I $P(GMRCRD,U,21) S GMRCLOC=$$GET1^DIQ(4,$P(GMRCRD,U,21),.01)
.E S GMRCLOC=$$GET1^DIQ(4,$P(GMRCRD,U,23),.01)
S:'$L(GMRCLOC) GMRCLOC=GMRCUL
;
D BLD("FTR",0,1,0,GMRCEQL)
D BLD("FTR",1,1,0,GMRCEQL)
;
I ($G(GMRCSG("GMRCSIGM"))="electronic") D I 1
.D BLD("FTR",0,1,0,"SIGNATURE & TITLE: ")
.D BLD("FTR",0,0,20,$G(GMRCSG("GMRCSIG"))_" /es/")
.D BLD("FTR",0,0,54,"|")
.D BLD("FTR",0,1,20,$G(GMRCSG("GMRCSIGT")))
.D BLD("FTR",0,0,54,"|DATE: "_$$EXDT($G(GMRCSG("GMRCSDT"))))
E D
.D BLD("FTR",0,1,0,"AUTHOR & TITLE: ")
.D BLD("FTR",0,0,20,$G(GMRCSG("GMRCSIG")))
.D BLD("FTR",0,0,54,"|")
.D BLD("FTR",0,1,20,$G(GMRCSG("GMRCSIGT")))
.D BLD("FTR",0,0,54,"|DATE: "_$$EXDT($G(GMRCSG("GMRCSDT"))))
;
S GMRCFAC1=+$G(DUZ(2))
S:'GMRCFAC1 GMRCFAC1=+$$SITE^VASITE()
S GMRCFAC1=$$GET1^DIQ(4,+GMRCFAC1,.01)
;
D BLD("FTR",0,1,0,GMRCDVL)
D BLD("FTR",0,1,0,"ID #:"_$E(GMRCUL,1,8))
D BLD("FTR",0,0,12,"|ORGANIZATION:"_$J($E(GMRCFAC1,1,17),17))
D BLD("FTR",0,0,45,"|REG #:"_$E(GMRCUL,1,4))
D BLD("FTR",0,0,58,"|LOC: "_$E($G(GMRCLOC),1,11))
;
I $L(GMRCRMBD) D I 1
.D BLD("FTR",0,1,12,"|")
.D BLD("FTR",0,0,45,"|")
.D BLD("FTR",0,0,58,"|RM/BD: "_GMRCRMBD)
;
D BLD("FTR",0,1,0,GMRCDVL)
;
F SUB=0,1 D
.I SUB D BLD("FTR",SUB,1,33,"Page ","GMRCPG,38"_" FIRST ONE") I 1
.E I '$G(GMRCGUI) D BLD("FTR",SUB,1,33,"Page ","GMRCPG,38"_" SECOND ONE")
I $G(GMRCPG)=0 D BLD("FTR",0,1,51,"Standard Form 513 (Rev 9-77)")
Q
;
CONSRQ(GMRCRQ) ;
;
N ORND,ORFL,REF
I '$L(GMRCRQ) Q "Consult"
S ORND=$P(GMRCRQ,";",1),ORFL=$P(GMRCRQ,";",2),REF=U_ORFL_ORND_",0)"
S GMRCRQ=$P($G(@(REF)),U,2)
Q:$L(GMRCRQ) GMRCRQ Q "Consult"
;
EXDT(X) ;EXTERNAL DATE FORMAT
;
N DATE,TIME,HR,MN,PD,Y,%DT
Q:'$L(X) ""
I '(X?7N.1".".6N) S %DT="PTS" D ^%DT S X=Y
Q $$FMTE^XLFDT(X,"5PMZ")
;
PRCMT(CMT) ;
;
Q $P($G(^GMR(123.1,+CMT,0)),U,8)
;
;
BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) ;
;
Q:'$L($G(SUB))
N LINECNT
;
F LINECNT=1:1:+LINE S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX)+1,0)=""
;
S $E(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),0),TAB+1)=TEXT
I $L($G(RUNTIME)) S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),1)=RUNTIME
;
S GMRCLAST=SUB
Q
;
SUB(ZONE,SUB,NDX,TEXT) ;
;
N NEXT
S NEXT=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE," "),-1)+1
S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,NEXT,0)=TEXT
Q
;
LASTLN(SUB,NDX) ;
Q +$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCP5B 6670 printed Apr 09, 2024@20:53:07 Page 2
GMRCP5B ;SLC/DCM,RJS - Print Consult form 513 (Gather Data - Footers, Provisional Diagnosis and Reason For Request) ;12/10/14 14:16
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4,13,12,15,24,23,22,29,65,66,73,81**;Dec 27, 1997;Build 6
+2 ;
+3 ; Patch #23 add "SERVICE RENDERED AS:" to SF513
+4 ;ICRs
+5 ;GLOBALS/FILES
+6 ;;#872 PROTOCOL ^ORD(101) #2849 PROTOCOL #10035 PATIENT FILE #10040 HOSPITAL LOCATION(^SC) #10060 NEW PERSON
+7 ;ROUTINES/APIs
+8 ;;#1252 SDUTL3 #2056 $$GET1^DIQ #4156 REGISTRATION, COMBAT VETERAN STATUS #10003 %DT #10061 VADPT #10103 FMTE^XLFDT #10112 VASITE
+9 QUIT
+10 ;
INIT(GMRCSG) ; Initialize the form
+1 ;
+2 DO HDR^GMRCP5D
DO FTR(.GMRCSG)
DO REQUEST
DO PDIAG
QUIT
+3 ;
REQUEST ;
+1 NEW GMRCX
+2 ;
+3 IF $LENGTH($TEXT(OUTPTPR^SDUTL3))
Begin DoDot:1
+4 SET GMRCX=$PIECE($$OUTPTPR^SDUTL3(DFN),U,2)
+5 if $LENGTH(GMRCX)
DO BLD("REQ",1,1,0,"Current Primary Care Provider: "_GMRCX)
End DoDot:1
+6 IF $LENGTH($TEXT(OUTPTTM^SDUTL3))
Begin DoDot:1
+7 SET GMRCX=$PIECE($$OUTPTTM^SDUTL3(DFN),U,2)
+8 if $LENGTH(GMRCX)
DO BLD("REQ",1,1,0," Current Primary Care Team: "_GMRCX)
End DoDot:1
+9 ;
+10 IF $ORDER(^TMP("GMRC",$JOB,"OUTPUT","REQ",0))
DO BLD("REQ",1,1,0,"")
+11 ;
+12 DO SUB("H","REQ",1,"Reason For Request continued.")
+13 DO SUB("H","REQ",1," ")
+14 ;
+15 DO BLD("REQ",1,1,0,"REASON FOR REQUEST: (Complaints and findings)")
+16 IF '$ORDER(^GMR(123,GMRCIFN,20,0))
DO BLD("REQ",1,1,0,"")
IF 1
+17 IF '$TEST
Begin DoDot:1
+18 NEW LN
SET LN=0
FOR
SET LN=$ORDER(^GMR(123,GMRCIFN,20,LN))
if LN=""
QUIT
Begin DoDot:2
+19 DO BLD("REQ",1,1,0,^GMR(123,GMRCIFN,20,LN,0))
End DoDot:2
End DoDot:1
+20 ;
+21 QUIT
PDIAG ;
+1 ;
+2 ;WAT GMRC 73
+3 NEW GMRCD,GMRCCODE,GMRCDA,GMRCSYS,CODINTXT
+4 SET GMRCD=""
SET GMRCCODE=""
SET GMRCSYS=""
+5 ;free txt prov diag
SET GMRCD=$GET(^GMR(123,GMRCIFN,30))
+6 ;ICD code^prov diag date^coding system
SET GMRCCODE=$GET(^GMR(123,GMRCIFN,30.1))
+7 SET CODINTXT="("_GMRCCODE_")"
+8 IF $LENGTH(GMRCCODE)>0
Begin DoDot:1
+9 ;coding system
SET GMRCSYS=$PIECE(GMRCCODE,U,3)
SET GMRCSYS=$SELECT(GMRCSYS="ICD":"ICD-9-CM",GMRCSYS="10D":"ICD-10-CM",1:"")
+10 ;actual code
SET GMRCCODE=$PIECE(GMRCCODE,U)
+11 SET GMRCSYS="("_GMRCSYS_" "_$GET(GMRCCODE)_")"
End DoDot:1
+12 IF GMRCD[$GET(CODINTXT)
Begin DoDot:1
+13 SET GMRCD=$EXTRACT(GMRCD,0,($LENGTH(GMRCD)-$LENGTH(CODINTXT)))
End DoDot:1
+14 ;
+15 DO BLD("PDIAG",1,1,0,"PROVISIONAL DIAG: "_GMRCD_$GET(GMRCSYS))
+16 ;/GMRC 73
+17 DO BLD("PDIAG",1,1,0,GMRCDVL)
+18 ;
+19 SET (GMRCQSTR,GMRCPGR,GMRCIPH,GMRCQSTT)=""
+20 ;
+21 IF $SELECT('$PIECE(GMRCRD,U,23):1,$PIECE(GMRCRD(12),U,5)="P":1,1:0)
Begin DoDot:1
+22 SET GMRCQSTR=$PIECE(GMRCRD,U,14)
+23 if 'GMRCQSTR
SET GMRCQSTR=$$GET1^DIQ(100,+$PIECE(GMRCRD,U,3),1)
+24 SET GMRCPGR=$$GET1^DIQ(200,+$GET(GMRCQSTR),.137)
if '$LENGTH(GMRCPGR)
SET GMRCPGR=$$GET1^DIQ(200,+$GET(GMRCQSTR),.138)
+25 SET GMRCIPH=$$GET1^DIQ(200,$GET(GMRCQSTR),.132)
+26 ;
+27 SET GMRCQSTT=$$GET1^DIQ(200,+$GET(GMRCQSTR),20.3)
+28 if '$LENGTH(GMRCQSTT)
SET GMRCQSTT=$$GET1^DIQ(200,+$GET(GMRCQSTR),8)
+29 SET GMRCQSTR=$$GET1^DIQ(200,+$GET(GMRCQSTR),.01)
End DoDot:1
+30 ;
+31 IF $PIECE(GMRCRD,U,23)
IF $PIECE(GMRCRD(12),U,5)="F"
Begin DoDot:1
+32 SET GMRCQSTR=$PIECE(GMRCRD(12),U,6)
+33 SET GMRCIPH=$PIECE(GMRCRD(13),U,2)
+34 SET GMRCPGR=$PIECE(GMRCRD(13),U,3)
End DoDot:1
+35 ;
+36 SET GMRCIPH="(Phone: "_GMRCIPH_")"
+37 SET GMRCPGR="(Pager: "_GMRCPGR_")"
+38 ;
+39 DO BLD("PDIAG",1,1,0,"REQUESTED BY: ")
+40 DO BLD("PDIAG",1,0,35,"|PLACE:")
+41 DO BLD("PDIAG",1,0,58,"|URGENCY:")
+42 ;
+43 DO BLD("PDIAG",1,1,0,$EXTRACT(GMRCQSTR,1,37))
+44 DO BLD("PDIAG",1,0,35,"|"_$EXTRACT($PIECE($GET(^ORD(101,+$PIECE(GMRCRD,U,10),0)),U,2),1,20))
+45 DO BLD("PDIAG",1,0,58,"|"_$EXTRACT($PIECE($GET(^ORD(101,+$PIECE(GMRCRD,U,9),0)),U,2),1,18))
+46 ;
+47 IF $LENGTH(GMRCQSTT)
Begin DoDot:1
+48 DO BLD("PDIAG",1,1,0,GMRCQSTT)
+49 DO BLD("PDIAG",1,0,35,"|")
+50 DO BLD("PDIAG",1,0,58,"|")
End DoDot:1
+51 DO BLD("PDIAG",1,1,0,GMRCPGR)
+52 DO BLD("PDIAG",1,0,35,"|SERVICE RENDERED AS:")
+53 ;WAT/66/81
DO BLD("PDIAG",1,0,58,"|CLINICALLY IND. DATE:")
+54 DO BLD("PDIAG",1,0,58,"|")
+55 SET GMRCINOU=$SELECT($PIECE(GMRCRD,U,18)="O":"Outpatient",1:"Inpatient")
+56 IF $DATA(GMRCIPH)>0
Begin DoDot:1
+57 DO BLD("PDIAG",1,1,0,GMRCIPH)
+58 DO BLD("PDIAG",1,0,35,"|"_GMRCINOU)
End DoDot:1
+59 IF '$TEST
Begin DoDot:1
+60 DO BLD("PDIAG",1,1,35,"|"_GMRCINOU)
End DoDot:1
+61 DO BLD("PDIAG",1,0,58,"|")
+62 ;WAT/66/81
DO BLD("PDIAG",1,0,58,"|"_$$FMTE^XLFDT($PIECE(GMRCRD,U,24),1))
+63 KILL GMRCINOU
+64 ;***************************************************************
+65 DO BLD("PDIAG",1,1,0,GMRCDVL)
+66 ;
+67 QUIT
+68 ;
FTR(GMRCSG) ;Footer of form 513
+1 ;
+2 NEW GMRCRMBD,GMRCFAC1,GMRCLOC,GMRCX,SUB,VAIN,VAPA,VAERR
+3 ;
+4 DO ADD^VADPT
DO INP^VADPT
+5 ;
+6 SET (GMRCLOC,GMRCRMBD)=""
+7 SET GMRCLOC=$PIECE($GET(VAIN(4)),U,2)
+8 SET GMRCRMBD=$GET(VAIN(5))
+9 if '$LENGTH(GMRCLOC)
SET GMRCLOC=$PIECE($GET(^SC(+$PIECE($GET(^GMR(123,+GMRCIFN,0)),U,4),0)),U,1)
+10 ;No location, IFC - consulting site
+11 IF '$LENGTH(GMRCLOC)
IF $PIECE(GMRCRD,U,23)
IF $PIECE($GET(GMRCRD(12)),U,5)="F"
Begin DoDot:1
+12 IF $PIECE(GMRCRD,U,21)
SET GMRCLOC=$$GET1^DIQ(4,$PIECE(GMRCRD,U,21),.01)
+13 IF '$TEST
SET GMRCLOC=$$GET1^DIQ(4,$PIECE(GMRCRD,U,23),.01)
End DoDot:1
+14 if '$LENGTH(GMRCLOC)
SET GMRCLOC=GMRCUL
+15 ;
+16 DO BLD("FTR",0,1,0,GMRCEQL)
+17 DO BLD("FTR",1,1,0,GMRCEQL)
+18 ;
+19 IF ($GET(GMRCSG("GMRCSIGM"))="electronic")
Begin DoDot:1
+20 DO BLD("FTR",0,1,0,"SIGNATURE & TITLE: ")
+21 DO BLD("FTR",0,0,20,$GET(GMRCSG("GMRCSIG"))_" /es/")
+22 DO BLD("FTR",0,0,54,"|")
+23 DO BLD("FTR",0,1,20,$GET(GMRCSG("GMRCSIGT")))
+24 DO BLD("FTR",0,0,54,"|DATE: "_$$EXDT($GET(GMRCSG("GMRCSDT"))))
End DoDot:1
IF 1
+25 IF '$TEST
Begin DoDot:1
+26 DO BLD("FTR",0,1,0,"AUTHOR & TITLE: ")
+27 DO BLD("FTR",0,0,20,$GET(GMRCSG("GMRCSIG")))
+28 DO BLD("FTR",0,0,54,"|")
+29 DO BLD("FTR",0,1,20,$GET(GMRCSG("GMRCSIGT")))
+30 DO BLD("FTR",0,0,54,"|DATE: "_$$EXDT($GET(GMRCSG("GMRCSDT"))))
End DoDot:1
+31 ;
+32 SET GMRCFAC1=+$GET(DUZ(2))
+33 if 'GMRCFAC1
SET GMRCFAC1=+$$SITE^VASITE()
+34 SET GMRCFAC1=$$GET1^DIQ(4,+GMRCFAC1,.01)
+35 ;
+36 DO BLD("FTR",0,1,0,GMRCDVL)
+37 DO BLD("FTR",0,1,0,"ID #:"_$EXTRACT(GMRCUL,1,8))
+38 DO BLD("FTR",0,0,12,"|ORGANIZATION:"_$JUSTIFY($EXTRACT(GMRCFAC1,1,17),17))
+39 DO BLD("FTR",0,0,45,"|REG #:"_$EXTRACT(GMRCUL,1,4))
+40 DO BLD("FTR",0,0,58,"|LOC: "_$EXTRACT($GET(GMRCLOC),1,11))
+41 ;
+42 IF $LENGTH(GMRCRMBD)
Begin DoDot:1
+43 DO BLD("FTR",0,1,12,"|")
+44 DO BLD("FTR",0,0,45,"|")
+45 DO BLD("FTR",0,0,58,"|RM/BD: "_GMRCRMBD)
End DoDot:1
IF 1
+46 ;
+47 DO BLD("FTR",0,1,0,GMRCDVL)
+48 ;
+49 FOR SUB=0,1
Begin DoDot:1
+50 IF SUB
DO BLD("FTR",SUB,1,33,"Page ","GMRCPG,38"_" FIRST ONE")
IF 1
+51 IF '$TEST
IF '$GET(GMRCGUI)
DO BLD("FTR",SUB,1,33,"Page ","GMRCPG,38"_" SECOND ONE")
End DoDot:1
+52 IF $GET(GMRCPG)=0
DO BLD("FTR",0,1,51,"Standard Form 513 (Rev 9-77)")
+53 QUIT
+54 ;
CONSRQ(GMRCRQ) ;
+1 ;
+2 NEW ORND,ORFL,REF
+3 IF '$LENGTH(GMRCRQ)
QUIT "Consult"
+4 SET ORND=$PIECE(GMRCRQ,";",1)
SET ORFL=$PIECE(GMRCRQ,";",2)
SET REF=U_ORFL_ORND_",0)"
+5 SET GMRCRQ=$PIECE($GET(@(REF)),U,2)
+6 if $LENGTH(GMRCRQ)
QUIT GMRCRQ
QUIT "Consult"
+7 ;
EXDT(X) ;EXTERNAL DATE FORMAT
+1 ;
+2 NEW DATE,TIME,HR,MN,PD,Y,%DT
+3 if '$LENGTH(X)
QUIT ""
+4 IF '(X?7N.1".".6N)
SET %DT="PTS"
DO ^%DT
SET X=Y
+5 QUIT $$FMTE^XLFDT(X,"5PMZ")
+6 ;
PRCMT(CMT) ;
+1 ;
+2 QUIT $PIECE($GET(^GMR(123.1,+CMT,0)),U,8)
+3 ;
+4 ;
BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) ;
+1 ;
+2 if '$LENGTH($GET(SUB))
QUIT
+3 NEW LINECNT
+4 ;
+5 FOR LINECNT=1:1:+LINE
SET ^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX)+1,0)=""
+6 ;
+7 SET $EXTRACT(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),0),TAB+1)=TEXT
+8 IF $LENGTH($GET(RUNTIME))
SET ^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),1)=RUNTIME
+9 ;
+10 SET GMRCLAST=SUB
+11 QUIT
+12 ;
SUB(ZONE,SUB,NDX,TEXT) ;
+1 ;
+2 NEW NEXT
+3 SET NEXT=$ORDER(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,ZONE," "),-1)+1
+4 SET ^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,ZONE,NEXT,0)=TEXT
+5 QUIT
+6 ;
LASTLN(SUB,NDX) ;
+1 QUIT +$ORDER(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX," "),-1)
+2 ;
