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

BEHOENPS.m

Go to the documentation of this file. 
  1. BEHOENPS ;MSC/IND/DKM - Summary Report for Selected Encounter ;05-Jan-2010 08:03;PLS
  1.  ;;1.1;BEH COMPONENTS;**005004**;Mar 20, 2007
  1.  ;=================================================================
  1.  ; Batch entry point
  1.  ;   BEHFLG = Which report sections to include (default to all)
  1.  ;            where N=all notes, S=signed notes O=orders, P=PCC data
  1. BATCH(BEHFLG) ;EP
  1.  N BEHQUIT,BEHVSIT,BEHDAT1,BEHDAT,BEHDATX,BEHNOW,X
  1.  S BEHNOW=$$NOW^XLFDT,BEHNOW=$S(BEHNOW#1<.17:BEHNOW\1,1:$$FMADD^XLFDT(BEHNOW\1,-1))
  1.  S BEHDAT1=$$GET^XPAR("PKG","BEHOENPS SUMMARY START")\1
  1.  D:'BEHDAT1 ADD^XPAR("PKG","BEHOENPS SUMMARY START",,BEHNOW)
  1.  S BEHDAT2=$$GET^XPAR("PKG","BEHOENPS SUMMARY END")\1
  1.  D:'BEHDAT2 ADD^XPAR("PKG","BEHOENPS SUMMARY END",,BEHNOW)
  1.  Q:BEHDAT1>BEHNOW
  1.  I 'BEHDAT1 D
  1.  .S BEHDAT1=$$NOW^XLFDT,X=BEHDAT1#1,BEHDAT1=BEHDAT1\1
  1.  .S:X<.1 BEHDAT1=$$FMADD^XLFDT(BEHDAT1,-1)
  1.  S:BEHDAT2<BEHDAT1 BEHDAT2=BEHDAT1
  1.  S BEHDAT=BEHDAT1-.1,BEHDAT2=BEHDAT2+.9
  1.  U IO
  1.  F  S BEHDAT=$O(^AUPNVSIT("B",BEHDAT)),BEHVSIT=0 Q:'BEHDAT!(BEHDAT>BEHDAT2)  D  Q:$G(BEHQUIT)
  1.  .F  S BEHVSIT=$O(^AUPNVSIT("B",BEHDAT,BEHVSIT)) Q:'BEHVSIT  D REPORT(BEHVSIT,.BEHQUIT,.BEHFLG)  Q:$G(BEHQUIT)
  1.  S BEHDAT=$$FMADD^XLFDT(BEHNOW,1)
  1.  D ^%ZISC
  1.  Q:$G(BEHQUIT)
  1.  D CHG^XPAR("PKG","BEHOENPS SUMMARY START",,BEHDAT)
  1.  D CHG^XPAR("PKG","BEHOENPS SUMMARY END",,BEHDAT)
  1.  Q
  1.  ; RPC: Retrieve report
  1. GETRPT(DATA,BEHVSIT,BEHFLG) ;PEP - Retrieve report
  1.  S:'$L($G(DATA)) DATA=$$TMPGBL^CIAVMRPC(99)
  1.  I '$G(BEHVSIT) S @DATA@(1)="No visit has been selected." Q
  1.  D CAPTURE^CIAUHFS("D REPORT^BEHOENPS(BEHVSIT,.BEHFLG)",DATA,80)
  1.  S:'$D(@DATA) @DATA@(1)="No information on visit"
  1.  Q
  1.  ; Entry point for OE/RR REPORT file
  1. OERRRPT(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;EP
  1.  D GETRPT(.ROOT,$$VSTR2VIS^BEHOENCX(ORDFN,$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")))
  1.  Q
  1.  ; Generate specified report segments for a visit abstract
  1. REPORT(BEHVSIT,BEHQUIT,BEHFLG) ;EP
  1.  N BEHLP,BEHRTN,BEHTBL,X,Y
  1.  Q:BEHVSIT'>0
  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,"SOPX")
  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,.BEHQUIT)")
  1.  Q
  1.  ; Report flag control
  1. FLAG ;;N;NOTES;$D(^TIU)
  1.  ;;S;NOTES2;$D(^TIU)
  1.  ;;O;ORDERS;$L($T(^ORQ1))
  1.  ;;P;PCC;$L($T(^APCDVDSP))
  1.  ;;X;PCE;$L($T(PCE^BEHOENPS))
  1.  ;;
  1.  ; Display all notes associated with specified visit
  1.  ; Optionally limit notes to those with the specified status (BEHST).
  1. NOTES(BEHVSIT,BEHQUIT,BEHST) ;
  1.  N IEN
  1.  F IEN=0:0 S IEN=$O(^TIU(8925,"V",BEHVSIT,IEN)) Q:'IEN  D  Q:$G(BEHQUIT)
  1.  .I $L($G(BEHST)),$$STATUS^TIULC(IEN)'=BEHST Q
  1.  .D GETPN(IEN)
  1.  Q
  1.  ; Display all signed notes associated with specific visit
  1. NOTES2(BEHVSIT,BEHQUIT) ;
  1.  D NOTES(.BEHVSIT,.BEHQUIT,"completed")
  1.  Q
  1.  ; Display all orders associated with specified visit
  1. ORDERS(BEHVSIT,BEHQUIT) ;
  1.  N DAT,DFN,ORLIST,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.  S HDR="ORDERS"
  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.  .D HDR(.HDR,ORD("TX")+3)
  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.  K ^TMP("ORR",$J)
  1.  Q
  1.  ; Display all PCC data associated with specified visit
  1. PCC(APCDVDSP,BEHQUIT) ;
  1.  Q:DUZ("AG")'="I"
  1.  D EN^APCDVDSP
  1.  ;S:$G(APCDBRK) BEHQUIT=1
  1.  Q
  1.  ; Extract specified note
  1. GETPN(TIUDA) ;
  1.  Q:'$$CANDO^TIULP(TIUDA,"VIEW")
  1.  N GBL,ERR,TIU,HLF,IDX,HDR
  1.  S GBL=$NA(^TMP("BEHOENPS",$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("BEHOENPS",$J,TIUDA)
  1.  K ^TMP("BEHOENPS",$J)
  1.  Q:$G(ERR)
  1.  S HDR=TIU(.01,"E")
  1.  D HDR(.HDR)
  1.  W "AUTHOR: ",TIU(1202,"E"),?HLF,"PATIENT NAME: ",TIU(.02,"E"),!
  1.  W "SIGNED BY: ",TIU(1502,"E"),?HLF,"STATUS: ",TIU(.05,"E"),!
  1.  W "VISIT: ",TIU(.03,"E"),?HLF,"LOCATION: ",TIU(1205,"E"),!!
  1.  F IDX=0:0 S IDX=$O(TIU("TEXT",IDX)) Q:'IDX  D  Q:$G(BEHQUIT)
  1.  .D HDR(.HDR)
  1.  .W:'$G(BEHQUIT) TIU("TEXT",IDX,0),!
  1.  I '$G(BEHQUIT),$L($G(TIU(1501,"E"))) D
  1.  .W !,"/es/ "_$G(TIU(1503,"E"))
  1.  .W !,"Signed: "_$G(TIU(1501,"E"))
  1.  Q
  1.  ; Get DFN from visit ien
  1. DFN(BEHVSIT) ;
  1.  Q +$P($G(^AUPNVSIT(BEHVSIT,0)),U,5)
  1.  ; Start new page and output header if exceed line count
  1. HDR(HDR,CNT) ;
  1.  S CNT=$G(CNT,1),HDR(0)=$G(HDR(0),IOSL)+CNT
  1.  Q:HDR(0)<(IOSL-CNT)
  1.  I $D(HDR(1)),$E(IOST)="C" D  Q:$G(BEHQUIT)
  1.  .N X
  1.  .R "Press RETURN or ENTER to continue...",X:$G(DTIME,300),!
  1.  .S:X[U!'$T BEHQUIT=1
  1.  E  W:$D(HDR(1)) $$CJ^XLFSTR("Continued on next page ==>",IOM)
  1.  S HDR(0)=6,HDR(1)=$G(HDR(1))+1
  1.  S:'$D(HDR(2)) HDR(2)="HRN: "_$$HRN^BEHOPTCX($$DFN(BEHVSIT)),HDR(3)="DOS: "_$$ENTRY^CIAUDT(+$G(^AUPNVSIT(BEHVSIT,0))),HDR(4)="VISIT IEN: "_BEHVSIT,HDR=$$CJ^XLFSTR("  "_HDR_"  ",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 "_HDR(1)_">",IOM),!!
  1.  Q
  1. PCE(BEHVSIT,BEHQUIT) ;Get visit information
  1.  ;Added this entry point for non-IHS sites
  1.  Q:DUZ("AG")="I"
  1.  Q:'$D(BEHVSIT)
  1.  Q:'BEHVSIT
  1.  Q:'$D(^AUPNVSIT(BEHVSIT,0))
  1.  D DSP,EOJ
  1.  Q
  1. DSP I $D(IOF),'$D(BEHOENPS("NO IOF")) W @IOF
  1.  N D0,DA,DIC,DIQ,DR,DL,DK,DX,S,X,XX
  1.  S BEHBRK=0 ;ACC
  1.  S BEHVDSH="-----------------------------"
  1.  S XX=$$^MSCDPTID(DFN)
  1.  S X="",$P(X,"~",80)="" W !!,X,!!,"VISIT IEN:  ",BEHVSIT,!
  1.  S X="MRN: "_XX W !,X,!
  1.  W BEHVDSH,"     VISIT FILE     ",BEHVDSH
  1.  S DIC="^AUPNVSIT(",DA=BEHVSIT D EN^DIQ
  1. DSPLY1 ;DISPLAY V FILE DATA
  1.  S BEHVFLE=9000010 F BEHVL=0:0 S BEHVFLE=$O(^DIC(BEHVFLE)) Q:BEHVFLE>9000010.99!(BEHVFLE'=+BEHVFLE)!(BEHBRK)  D DSPLY2
  1.  Q:BEHBRK  ;ACC
  1.  I 'BEHBRK S X="",$P(X,"~",80)="" W !!,X,!!
  1.  Q
  1. DSPLY2 S BEHVNM=$P(^DIC(BEHVFLE,0),U)
  1.  S BEHVDG=^DIC(BEHVFLE,0,"GL"),BEHVIGR=BEHVDG_"""AD"",BEHVSIT,BEHVDFN)"
  1.  S BEHVDFN="" F BEHVI=1:1 S BEHVDFN=$O(@BEHVIGR) Q:BEHVDFN=""!(BEHBRK)  D DSPLY3 Q:BEHBRK
  1.  Q
  1. DSPLY3 ;
  1.  I $Y>(IOSL-5) D HEAD Q:BEHBRK
  1.  I BEHVI<2 S X=20-$L(BEHVNM),Y=X\2,Z=X-Y W !,BEHVDSH,$J("",Z),BEHVNM,$J("",Y),BEHVDSH
  1.  S DIC=BEHVDG,DA=BEHVDFN,DIQ(0)="C" D EN^DIQ
  1.  Q
  1.  I '$D(ZTQUEUED),'$D(IO("S")),$E(IOST)="C",IO=IO(0) W !!,"Enter to continue, '^' to halt " R BEHX:DTIME S:'$T BEHBRK=1 S:BEHX="^" BEHBRK=1
  1.  Q:BEHBRK
  1.  K S
  1.  W:$D(IOF) @IOF
  1.  Q
  1. EOJ ; EOJ CLEANUP
  1.  I '$D(ZTQUEUED),'$D(IO("S")),'BEHBRK,'$D(BEHEIN),$E(IOST)="C",IO=IO(0) W !,"End of visit display, <ENTER> to Continue" R BEHX:DTIME
  1.  K X,Y
  1.  K BEHVDFN,BEHVDG,BEHVDSH,BEHVDSP,BEHVFLE,BEHVI,BEHVIGR,BEHVL,BEHVNM,BEHX,BEHBRK,BEHVSIT
  1.  Q