Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCP5B

GMRCP5B.m

Go to the documentation of this file. 
  1. GMRCP5B ;SLC/DCM,RJS,WAT - Print Consult form 513 (Gather Data - Footers, Provisional Diagnosis and Reason For Request) ;09/10/08
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**4,13,12,15,24,23,22,29,65**;Dec 27, 1997;Build 7
  1.  ;
  1.  ; Patch #23 add "SERVICE RENDERED AS:" to SF513
  1.  ; This routine invokes IA #1252 (SDUTL3),#10112 (VASITE)
  1.  ; DBIA 10035      ;PATIENT FILE
  1.  ; DBIA 2849       ;PROTOCOL
  1.  ; DBIA 10060      ;NEW PERSON
  1.  ; DBIA 10061      ;VADPT
  1.  ; 10103                ;FMTE^XLFDT
  1.  ; 10003                ;%DT
  1.  ; 2056                  ;$$GET1^DIQ
  1.  ; ICR 4156           ;REGISTRATION, COMBAT VETERAN STATUS
  1.  Q
  1.  ;
  1. INIT(GMRCSG) ; Initialize the form
  1.  ;
  1.  D HDR^GMRCP5D,FTR(.GMRCSG),REQUEST,PDIAG Q
  1.  ;
  1. REQUEST ;
  1.  N GMRCX
  1.  ;
  1.  I $L($T(OUTPTPR^SDUTL3)) D
  1.  .S GMRCX=$P($$OUTPTPR^SDUTL3(DFN),U,2)
  1.  .D:$L(GMRCX) BLD("REQ",1,1,0,"Current Primary Care Provider: "_GMRCX)
  1.  I $L($T(OUTPTTM^SDUTL3)) D
  1.  .S GMRCX=$P($$OUTPTTM^SDUTL3(DFN),U,2)
  1.  .D:$L(GMRCX) BLD("REQ",1,1,0,"    Current Primary Care Team: "_GMRCX)
  1.  ;
  1.  I $O(^TMP("GMRC",$J,"OUTPUT","REQ",0)) D BLD("REQ",1,1,0,"")
  1.  ;
  1.  D SUB("H","REQ",1,"Reason For Request continued.")
  1.  D SUB("H","REQ",1," ")
  1.  ;
  1.  D BLD("REQ",1,1,0,"REASON FOR REQUEST: (Complaints and findings)")
  1.  I '$O(^GMR(123,GMRCIFN,20,0)) D BLD("REQ",1,1,0,"") I 1
  1.  E  D
  1.  .N LN S LN=0 F  S LN=$O(^GMR(123,GMRCIFN,20,LN)) Q:LN=""  D
  1.  ..D BLD("REQ",1,1,0,^GMR(123,GMRCIFN,20,LN,0))
  1.  ;
  1.  Q
  1. PDIAG ;
  1.  ;
  1.  D BLD("PDIAG",1,1,0,"PROVISIONAL DIAG: "_$G(^GMR(123,GMRCIFN,30)))
  1.  D BLD("PDIAG",1,1,0,GMRCDVL)
  1.  ;
  1.  S (GMRCQSTR,GMRCPGR,GMRCIPH,GMRCQSTT)=""
  1.  ;
  1.  I $S('$P(GMRCRD,U,23):1,$P(GMRCRD(12),U,5)="P":1,1:0) D
  1.  .S GMRCQSTR=$P(GMRCRD,U,14)
  1.  .S:'GMRCQSTR GMRCQSTR=$$GET1^DIQ(100,+$P(GMRCRD,U,3),1)
  1.  .S GMRCPGR=$$GET1^DIQ(200,+$G(GMRCQSTR),.137) S:'$L(GMRCPGR) GMRCPGR=$$GET1^DIQ(200,+$G(GMRCQSTR),.138)
  1.  .S GMRCIPH=$$GET1^DIQ(200,+$G(GMRCQSTR),.132)
  1.  .;
  1.  .S GMRCQSTT=$$GET1^DIQ(200,+$G(GMRCQSTR),20.3)
  1.  .S:'$L(GMRCQSTT) GMRCQSTT=$$GET1^DIQ(200,+$G(GMRCQSTR),8)
  1.  .S GMRCQSTR=$$GET1^DIQ(200,+$G(GMRCQSTR),.01)
  1.  ;
  1.  I $P(GMRCRD,U,23),$P(GMRCRD(12),U,5)="F" D
  1.  .S GMRCQSTR=$P(GMRCRD(12),U,6)
  1.  .S GMRCIPH=$P(GMRCRD(13),U,2)
  1.  .S GMRCPGR=$P(GMRCRD(13),U,3)
  1.  ;
  1.  S GMRCIPH="(Phone: "_GMRCIPH_")"
  1.  S GMRCPGR="(Pager: "_GMRCPGR_")"
  1.  ;
  1.  D BLD("PDIAG",1,1,0,"REQUESTED BY: ")
  1.  D BLD("PDIAG",1,0,35,"|PLACE:")
  1.  D BLD("PDIAG",1,0,59,"|URGENCY:")
  1.  ;
  1.  D BLD("PDIAG",1,1,0,$E(GMRCQSTR,1,37))
  1.  D BLD("PDIAG",1,0,35,"|"_$E($P($G(^ORD(101,+$P(GMRCRD,U,10),0)),U,2),1,20))
  1.  D BLD("PDIAG",1,0,59,"|"_$E($P($G(^ORD(101,+$P(GMRCRD,U,9),0)),U,2),1,18))
  1.  ;
  1.  I $L(GMRCQSTT) D
  1.  .D BLD("PDIAG",1,1,0,GMRCQSTT)
  1.  .D BLD("PDIAG",1,0,35,"|")
  1.  .D BLD("PDIAG",1,0,59,"|")
  1.  D BLD("PDIAG",1,1,0,GMRCPGR)
  1.  D BLD("PDIAG",1,0,35,"|SERVICE RENDERED AS:")
  1.  D BLD("PDIAG",1,0,59,"|")
  1.  S GMRCINOU=$S($P(GMRCRD,U,18)="O":"Outpatient",1:"Inpatient")
  1.  I $D(GMRCIPH)>0 D
  1.  .D BLD("PDIAG",1,1,0,GMRCIPH)
  1.  .D BLD("PDIAG",1,0,35,"|"_GMRCINOU)
  1.  E  D
  1.  .D BLD("PDIAG",1,1,35,"|"_GMRCINOU)
  1.  D BLD("PDIAG",1,0,59,"|")
  1.  K GMRCINOU
  1.  ;***************************************************************
  1.  D BLD("PDIAG",1,1,0,GMRCDVL)
  1.  ;
  1.  Q
  1.  ;
  1. FTR(GMRCSG) ;Footer of form 513
  1.  ;
  1.  N GMRCRMBD,GMRCFAC1,GMRCLOC,GMRCX,SUB,VAIN,VAPA,VAERR
  1.  ;
  1.  D ADD^VADPT,INP^VADPT
  1.  ;
  1.  S (GMRCLOC,GMRCRMBD)=""
  1.  S GMRCLOC=$P($G(VAIN(4)),U,2)
  1.  S GMRCRMBD=$G(VAIN(5))
  1.  S:'$L(GMRCLOC) GMRCLOC=$P($G(^SC(+$P($G(^GMR(123,+GMRCIFN,0)),U,4),0)),U,1)
  1.  ;No location, IFC - consulting site
  1.  I '$L(GMRCLOC),$P(GMRCRD,U,23),$P($G(GMRCRD(12)),U,5)="F" D
  1.  .I $P(GMRCRD,U,21) S GMRCLOC=$$GET1^DIQ(4,$P(GMRCRD,U,21),.01)
  1.  .E  S GMRCLOC=$$GET1^DIQ(4,$P(GMRCRD,U,23),.01)
  1.  S:'$L(GMRCLOC) GMRCLOC=GMRCUL
  1.  ;
  1.  D BLD("FTR",0,1,0,GMRCEQL)
  1.  D BLD("FTR",1,1,0,GMRCEQL)
  1.  ;
  1.  I ($G(GMRCSG("GMRCSIGM"))="electronic") D  I 1
  1.  .D BLD("FTR",0,1,0,"SIGNATURE & TITLE: ")
  1.  .D BLD("FTR",0,0,20,$G(GMRCSG("GMRCSIG"))_" /es/")
  1.  .D BLD("FTR",0,0,54,"|")
  1.  .D BLD("FTR",0,1,20,$G(GMRCSG("GMRCSIGT")))
  1.  .D BLD("FTR",0,0,54,"|DATE: "_$$EXDT($G(GMRCSG("GMRCSDT"))))
  1.  E  D
  1.  .D BLD("FTR",0,1,0,"AUTHOR & TITLE: ")
  1.  .D BLD("FTR",0,0,20,$G(GMRCSG("GMRCSIG")))
  1.  .D BLD("FTR",0,0,54,"|")
  1.  .D BLD("FTR",0,1,20,$G(GMRCSG("GMRCSIGT")))
  1.  .D BLD("FTR",0,0,54,"|DATE: "_$$EXDT($G(GMRCSG("GMRCSDT"))))
  1.  ;
  1.  S GMRCFAC1=+$G(DUZ(2))
  1.  S:'GMRCFAC1 GMRCFAC1=+$$SITE^VASITE()
  1.  S GMRCFAC1=$$GET1^DIQ(4,+GMRCFAC1,.01)
  1.  ;
  1.  D BLD("FTR",0,1,0,GMRCDVL)
  1.  D BLD("FTR",0,1,0,"ID #:"_$E(GMRCUL,1,8))
  1.  D BLD("FTR",0,0,12,"|ORGANIZATION:"_$J($E(GMRCFAC1,1,17),17))
  1.  D BLD("FTR",0,0,45,"|REG #:"_$E(GMRCUL,1,4))
  1.  D BLD("FTR",0,0,58,"|LOC: "_$E($G(GMRCLOC),1,11))
  1.  ;
  1.  I $L(GMRCRMBD) D  I 1
  1.  .D BLD("FTR",0,1,12,"|")
  1.  .D BLD("FTR",0,0,45,"|")
  1.  .D BLD("FTR",0,0,58,"|RM/BD: "_GMRCRMBD)
  1.  ;
  1.  D BLD("FTR",0,1,0,GMRCDVL)
  1.  ;
  1.  F SUB=0,1 D
  1.  .I SUB D BLD("FTR",SUB,1,33,"Page ","GMRCPG,38"_" FIRST ONE") I 1
  1.  .E  I '$G(GMRCGUI) D BLD("FTR",SUB,1,33,"Page ","GMRCPG,38"_" SECOND ONE")
  1.  I $G(GMRCPG)=0 D BLD("FTR",0,1,51,"Standard Form 513 (Rev 9-77)")
  1.  Q
  1.  ;
  1. CONSRQ(GMRCRQ) ;
  1.  ;
  1.  N ORND,ORFL,REF
  1.  I '$L(GMRCRQ) Q "Consult"
  1.  S ORND=$P(GMRCRQ,";",1),ORFL=$P(GMRCRQ,";",2),REF=U_ORFL_ORND_",0)"
  1.  S GMRCRQ=$P($G(@(REF)),U,2)
  1.  Q:$L(GMRCRQ) GMRCRQ Q "Consult"
  1.  ;
  1. EXDT(X) ;EXTERNAL DATE FORMAT
  1.  ;
  1.  N DATE,TIME,HR,MN,PD,Y,%DT
  1.  Q:'$L(X) ""
  1.  I '(X?7N.1".".6N) S %DT="PTS" D ^%DT S X=Y
  1.  Q $$FMTE^XLFDT(X,"5PMZ")
  1.  ;
  1. PRCMT(CMT) ;
  1.  ;
  1.  Q $P($G(^GMR(123.1,+CMT,0)),U,8)
  1.  ;
  1.  ;
  1. BLD(SUB,NDX,LINE,TAB,TEXT,RUNTIME) ;
  1.  ;
  1.  Q:'$L($G(SUB))
  1.  N LINECNT
  1.  ;
  1.  F LINECNT=1:1:+LINE S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX)+1,0)=""
  1.  ;
  1.  S $E(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),0),TAB+1)=TEXT
  1.  I $L($G(RUNTIME)) S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,$$LASTLN(SUB,NDX),1)=RUNTIME
  1.  ;
  1.  S GMRCLAST=SUB
  1.  Q
  1.  ;
  1. SUB(ZONE,SUB,NDX,TEXT) ;
  1.  ;
  1.  N NEXT
  1.  S NEXT=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE," "),-1)+1
  1.  S ^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,NEXT,0)=TEXT
  1.  Q
  1.  ;
  1. LASTLN(SUB,NDX) ;
  1.  Q +$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1)
  1.  ;