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

BEHOENPV.m

Go to the documentation of this file. 
  1. BEHOENPV ;IHS/CIA/MGH - Summary Report for Selected Encounter ;21-Jan-2013 17:05;DU
  1.  ;;1.1;BEH COMPONENTS;**005002,005004,005009**;Mar 20, 2007
  1.  ;=================================================================
  1.  ;Added code to support eye, PHN and anticoag components
  1.  ; RPC: Retrieve report
  1. GETRPT(DATA,BEHVSIT,BEHFLG) ;EP
  1.  S DATA=$$TMPGBL^CIAVMRPC
  1.  I '$G(BEHVSIT) S @DATA@(1)="A visit has not been selected." Q
  1.  D CAPTURE^CIAUHFS("D REPORT^BEHOENPV(BEHVSIT,,.BEHFLG)",DATA,80)
  1.  S:'$D(@DATA) @DATA@(1)="No visit information was found."
  1.  Q
  1.  ; RPC: Retrieve report
  1.  ; Entry point for OE/RR REPORT file
  1. OERRRPT(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
  1.  ;N BEHVSIT
  1.  ;S BEHVSIT=$$VSTR2VIS^BEHOENCX(ORDFN,$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER"))
  1.  ;D GETRPT(.ROOT,BEHVSIT)
  1.  D GETRPT(.ROOT,$$VSTR2VIS^BEHOENCX(ORDFN,$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")))
  1.  Q
  1.  ; RPC: Retrieve reports for date range
  1. GETRPTS(DATA,DFN,BEHFLG,STRT,END) ;EP
  1.  S DATA=$$TMPGBL^CIAVMRPC
  1.  D CAPTURE^CIAUHFS("D REPORTS^BEHOENPV(DFN,.BEHFLG,STRT,END)",DATA,80)
  1.  S:'$D(@DATA) @DATA@(1)="No visits found within specified date range."
  1.  Q
  1.  ; RPC: Retrieve report
  1.  ; Entry point for OE/RR REPORT file
  1. OERRRPTS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
  1.  D GETRPTS(.ROOT,ORDFN,,ALPHA,OMEGA)
  1.  Q
  1. REPORTS(DFN,BEHFLG,STRT,END) ;
  1.  N BEHVSIT,DAT
  1.  S BEHVSIT=0
  1.  F  S BEHVSIT=$O(^AUPNVSIT("AC",DFN,BEHVSIT)) Q:'BEHVSIT  D
  1.  .S DAT=+$G(^AUPNVSIT(BEHVSIT,0))
  1.  .I DAT,DAT'<STRT,DAT'>END D
  1.  ..D REPORT(BEHVSIT,,.BEHFLG)
  1.  ..W !!,$$REPEAT^XLFSTR("=",80),!
  1.  Q
  1. OERRPB(ROOT,DFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
  1.  N BEHFLAG,ORDFN,XQORNOD
  1.  Q:'$G(DFN)
  1.  S ORDFN=DFN_";DPT(",XQORNOD=1
  1.  D REPORT(+$G(ORVSIT),,.BEHFLAG)
  1.  Q
  1.  ; Generate specified report segments for a visit abstract
  1. REPORT(BEHVSIT,BEHQUIT,BEHFLG) ;
  1.  N BEHLP,BEHRTN,BEHTBL,X,Y,DFN,I,TODAY,PAGE,LINE,ORLIST,HDR
  1.  N BEHNAME,BEHDOB,BEHHRN,BEHVLOC,BEHVPRV,BEHVDT,BEHVFAC,BEHDOCID
  1.  Q:BEHVSIT'>0
  1.  ;Get the visit information needed for the header
  1.  ;This information stays for each page of the report
  1.  S PAGE=0,LINE=0
  1.  D DFN(BEHVSIT)
  1.  ;Loop through the items to be included in the report in their assigned order
  1.  F BEHLP=0:1 S X=$P($T(FLAG+BEHLP),";;",2,99) Q:'$L(X)  D
  1.  .S Y=$P(X,";")
  1.  .S BEHTBL(Y,0)=$P(X,";",2),BEHTBL(Y,1)=$P(X,";",3,99)
  1.  S BEHFLG=$G(BEHFLG,"CMIKEPHNORVTYAU")
  1.  F BEHLP=1:1:$L(BEHFLG) D  Q:$G(BEHQUIT)
  1.  .S X=$E(BEHFLG,BEHLP)
  1.  .I $D(BEHTBL(X)),@BEHTBL(X,1) D @(BEHTBL(X,0)_"(BEHVSIT,DFN,.BEHQUIT)")
  1.  K ^TMP("ORR",$J)
  1.  Q
  1.  ; Report flag control
  1. FLAG ;;C;CHIEF;$L($T(^BEHOENPP))
  1.  ;;N;NOTES;$D(^TIU)
  1.  ;;S;NOTES2;$D(^TIU)
  1.  ;;O;ORDERS;$L($T(^ORQ1))
  1.  ;;E;EXAMS;$L($T(^BEHOENPP))
  1.  ;;H;FACTORS;$L($T(^BEHOENPP))
  1.  ;;P;EDU;$L($T(^BEHOENPP))
  1.  ;;V;POV;$L($T(^BEHOENPP))
  1.  ;;M;MEAS;$L($T(^BEHOENPP))
  1.  ;;I;IMMUN;$L($T(^BEHOENPP))
  1.  ;;K;SKIN;$L($T(^BEHOENPP))
  1.  ;;R;RESULTS;$L($T(^BEHOENPR))
  1.  ;;T;CPT;$L($T(^BEHOENPP))
  1.  ;;Y;EYE;$L($T(^BEHOENPP))
  1.  ;;A;ANTICOAG;$L($T(^BEHOENPP))
  1.  ;;U;PHN;$L($T(^BEHOENPP))
  1.  ;;
  1.  ; Display all notes associated with specified visit
  1.  ; Optionally limit notes to those with the specified status (BEHST).
  1. NOTES(BEHVSIT,DFN,BEHQUIT,BEHST) ;
  1.  N IEN,NAME
  1.  S NAME="PROGRESS NOTES"
  1.  F IEN=0:0 S IEN=$O(^TIU(8925,"V",BEHVSIT,IEN)) Q:'IEN  D  Q:$G(BEHQUIT)
  1.  .D:$L(NAME) HDR(NAME,1)
  1.  .S NAME=""
  1.  .D GETPN(IEN)
  1.  Q
  1. CHIEF(BEHVSIT,DFN,BEHQUIT) ;Get the chief complaint for this visit
  1.  D CHIEF^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. EXAMS(BEHVSIT,DFN,BEHQUIT) ;Get the exams for this visit
  1.  D EXAMS^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. FACTORS(BEHVSIT,DFN,BEHQUIT) ;Get the health factors for this visit
  1.  D FACTORS^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. EDU(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
  1.  D EDU^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. EYE(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
  1.  D EYE^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. ANTICOAG(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
  1.  D ANTICOAG^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. PHN(BEHVSIT,DFN,BEHQUIT) ;Get the education topics for this visit
  1.  D PHN^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1.  ; Display all orders associated with specified visit
  1. ORDERS(BEHVSIT,DFN,BEHQUIT) ;
  1.  N DAT,DFN,ORD,HDR,HLF,LOC,X,Y
  1.  S X=$G(^AUPNVSIT(BEHVSIT,0)),DAT=X\1,DFN=$P(X,U,5),LOC=$P(X,U,22)_";SC(",HLF=IOM\2
  1.  Q:'DAT
  1.  K ^TMP("ORR",$J)
  1.  D EN^ORQ1(DFN_";DPT(",,1,1,DAT,DAT,1)
  1.  Q:'$D(ORLIST)
  1.  Q:'$O(^TMP("ORR",$J,ORLIST,0))
  1.  S NAME="ORDERS"
  1.  D HDR(NAME,1)
  1.  F X=0:0 S X=$O(^TMP("ORR",$J,ORLIST,X)) Q:'X  K ORD M ORD=^(X) D  Q:$G(BEHQUIT)
  1.  .S Y=$P($G(^OR(100,+ORD,0)),U,10)
  1.  .I $L(Y),Y'=LOC Q
  1.  .S LINE=LINE+7
  1.  .I LINE>(IOSL-3) D HDR(NAME,5)
  1.  .W !,"ORDER #: ",+ORD,?HLF,"STATUS: ",$P(ORD,U,6),!
  1.  .W "START: ",$$FMTE^XLFDT($P(ORD,U,4)),?HLF,"STOP: ",$$FMTE^XLFDT($P(ORD,U,5)),!
  1.  .F Y=0:0 S Y=$O(ORD("TX",Y)) Q:'Y  W ORD("TX",Y),!
  1.  .W !
  1.  Q
  1.  ; Extract specified note
  1. GETPN(TIUDA) ;
  1.  Q:'$$CANDO^TIULP(TIUDA,"VIEW")
  1.  N GBL,ERR,TIU,HLF,IDX,HDR,STAT
  1.  S GBL=$NA(^TMP("BEHOENPV",$J)),HLF=IOM\2
  1.  K @GBL
  1.  D EXTRACT^TIULQ(TIUDA,GBL,.ERR,".01;.02;.03;.05;.07;.08;1202;1203;1205;1208;1209;1301;1307;1402;1501:1505;1507:1513;1701","",1,"E")
  1.  M TIU=^TMP("BEHOENPV",$J,TIUDA)
  1.  K ^TMP("BEHOENPV",$J)
  1.  Q:$G(ERR)
  1.  S HDR=TIU(.01,"E")
  1.  ;S LINE=LINE+3
  1.  D HDR(HDR,3)
  1.  W !,"AUTHOR: ",TIU(1202,"E")
  1.  W:$L(TIU(1502,"E")) ?HLF,"SIGNED BY: ",TIU(1502,"E")
  1.  W !,"STATUS: ",TIU(.05,"E"),!
  1.  S STAT=$$GET1^DIQ(8925,TIUDA,.05,"I")
  1.  Q:STAT'=7
  1.  F IDX=0:0 S IDX=$O(TIU("TEXT",IDX)) Q:'IDX  D  Q:$G(BEHQUIT)
  1.  .S LINE=LINE+1
  1.  .I LINE>(IOSL-3) D HDR(HDR,1)
  1.  .W:'$G(BEHQUIT) TIU("TEXT",IDX,0),!
  1.  I '$G(BEHQUIT),$L($G(TIU(1501,"E"))) D
  1.  .I LINE+2>(IOSL-3) D HDR(HDR,2)
  1.  .W !,"/es/ "_$G(TIU(1503,"E"))
  1.  .W !,"Signed: "_$G(TIU(1501,"E"))
  1.  Q
  1. POV(BEHVSIT,DFN,BEHQUIT) ;Get the POVs for this visit
  1.  D POV^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. MEAS(BEHVSIT,DFN,BEHQUIT) ;Get the measurments for this visit
  1.  D MEAS^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. IMMUN(BEHVSIT,DFN,BEHQUIT) ;Get the immunizations for this visit
  1.  D IMMUN^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. SKIN(BEHVSIT,DFN,BEHQUIT) ;Get the skin tests for this visit
  1.  D SKIN^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. CPT(BEHVSIT,DFN,BEHQUIT) ;Get the CPT codes forthis visit
  1.  D CPT^BEHOENPP(BEHVSIT,DFN,.BEHQUIT)
  1.  Q
  1. RESULTS(BEHVSIT,DFN,BEHQUIT) ;Get the results for the orders
  1.  D RESULTS^BEHOENPR(BEHVSIT,DFN,.ORLIST,.BEHQUIT)
  1.  Q
  1.  ; Get DFN from visit ien
  1. DFN(BEHVSIT) ;
  1.  N BEHI,TEMP,VADM,X
  1.  S DFN=$P($G(^AUPNVSIT(BEHVSIT,0)),U,5)
  1.  D DEM^VADPT
  1.  S BEHNAME=$G(VADM(1)),BEHDOB=$P($G(VADM(3)),U,2),BEHHRN=$$HRN^BEHOPTCX(DFN)
  1.  S BEHVDT=$$ENTRY^CIAUDT(+$G(^AUPNVSIT(BEHVSIT,0)))
  1.  S TEMP=+$P($G(^AUPNVSIT(BEHVSIT,0)),U,22)
  1.  S BEHVLOC=$P($G(^SC(TEMP,0)),U,1)
  1.  S TEMP=$P($G(^AUPNVSIT(BEHVSIT,0)),U,6)
  1.  S BEHVFAC=$P($G(^AUTTLOC(TEMP,0)),U,2)
  1.  S BEHI=""
  1.  K BEHVPRV
  1.  F  S BEHI=$O(^AUPNVPRV("AD",BEHVSIT,BEHI)) Q:BEHI=""  D
  1.  .S X=$G(^AUPNVPRV(BEHI,0))
  1.  .S BEHDOCID=$P(X,U),X=$P(X,U,4)
  1.  .I BEHDOCID="" S BEHVPRV(BEHI)="Unknown"
  1.  .E  S BEHVPRV($S(X="P":0,1:BEHI))=$P($G(^VA(200,BEHDOCID,0)),U,1)_"("_X_")"
  1.  D HDR1
  1.  Q
  1.  ; Start new page and output header if exceed line count
  1. HDR1 S CNT=$G(CNT,1),PAGE=PAGE+1
  1.  S HDR(1)="CLINIC: "_BEHVLOC
  1.  S HDR(2)="LOC. OF ENCOUNTER: "_BEHVFAC
  1.  S HDR(3)="VISIT/ADMIT DATE&TIME: "_BEHVDT
  1.  S HDR(4)=""
  1.  S:$D(BEHVPRV(0)) HDR(4)="ENCOUNTER PROVIDER(s): "_BEHVPRV(0)
  1.  W @IOF,!,HDR(1),?IOM-$L(HDR(2)),HDR(2),!
  1.  W !,HDR(3)
  1.  W !,HDR(4),!
  1.  F I=1:1:IOM W "_"
  1.  W !
  1.  S LINE=8
  1.  F I=0:0 S I=$O(BEHVPRV(I)) Q:'I  D
  1.  .W !,$$RJ^XLFSTR(BEHVPRV(I),30)
  1.  .S LINE=LINE+1
  1.  Q
  1. HDR(NAME,CNT) ;EP
  1.  N HDR
  1.  S LINE=LINE+CNT
  1.  I LINE<(IOSL-CNT) D
  1.  .S HDR=$$CJ^XLFSTR("  "_NAME_"  ",IOM,"-")
  1.  .W !!,HDR
  1.  .S LINE=LINE+CNT+1
  1.  E  D
  1.  .I PAGE>0,$E(IOST)="C" D  Q:$G(BEHQUIT)
  1.  ..N X
  1.  ..W !
  1.  ..R "Press RETURN or ENTER to continue...",X:$G(DTIME,300),!
  1.  ..S:X[U!'$T BEHQUIT=1
  1.  .E  W !,$$CJ^XLFSTR("Continued on next page ==>",IOM)
  1.  .S LINE=4,PAGE=PAGE+1
  1.  .S HDR(2)="HRN: "_BEHHRN,HDR(3)="DOS: "_BEHVDT,HDR(4)="VISIT IEN: "_BEHVSIT
  1.  .S HDR=$$CJ^XLFSTR("  "_NAME_"  ",IOM,"-")
  1.  .W @IOF,!,HDR(2),?IOM-$L(HDR(3))\2,HDR(3),?IOM-$L(HDR(4)),HDR(4),!,HDR,!
  1.  .W $$CJ^XLFSTR("<Page "_PAGE_">",IOM),!
  1.  Q