ORAM2 ;POR/RSF - ANTICOAGULATION MANAGEMENT RPCS (3 of 4) ; 1/17/18 6:41pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**307,339,354,361,391,459,451**;Dec 17, 1997;Build 8
;;Per VHA Directive 6402, this routine should not be modified
Q
;
; External References:
; $$GET1^DIQ ICR #2056
; $$SETSTR^VALM1 ICR #10116
; $$FMADD/$$FMDIFF/$$FMTE/$$NOW^XLFDT ICR #10103
; $$TITLE/$$UP^XLFSTR ICR #10104
; $$GET^XPAR ICR #2263
; ^AUTNPOV( ICR #1593
;
ALLGOAL(RESULT,DAYS,CLINIC) ; last inr for all pts seen in last x days
;;RPC = ORAM2 ALLGOAL
N ORAMDFN,ORAMNOW,ORAMCUT,ORAMCNT,ORAMPC,ORAMGOOD,ORAMBAD,ORAMBL
S ORAMDFN=0,ORAMCNT=0,ORAMGOOD=0,ORAMBAD=0
S ORAMNOW=$$NOW^XLFDT
S ORAMCUT=$$FMADD^XLFDT(ORAMNOW,-DAYS)
F S ORAMDFN=$O(^ORAM(103,ORAMDFN)) Q:'ORAMDFN D
. N ORAMFS,ORAM3D0,ORAMDATE,ORAMCLIN
. S ORAMFS=$O(^ORAM(103,ORAMDFN,3," "),-1) Q:$G(ORAMFS)=""
. S ORAMCLIN=$P($G(^ORAM(103,ORAMDFN,6)),U,2)
. I +$G(CLINIC),(ORAMCLIN'=CLINIC) Q
. S ORAM3D0=$G(^ORAM(103,ORAMDFN,3,ORAMFS,0)),ORAMDATE=$P(ORAM3D0,"^")
. I ($G(ORAMDATE)>$G(ORAMCUT)) D
.. N ORAMINR,ORAMGOAL,ORAMGLO,ORAMGHI
.. S ORAMINR=$P(ORAM3D0,"^",3),ORAMGOAL=$P(ORAM3D0,"^",12),ORAMGLO=$P(ORAMGOAL,"-"),ORAMGHI=$P(ORAMGOAL,"-",2) S:ORAMGHI[" " ORAMGHI=$P(ORAMGHI," ",2)
.. S ORAMGLO=ORAMGLO-(.1*ORAMGLO),ORAMGHI=ORAMGHI+(.1*ORAMGHI)
.. S ORAMCNT=ORAMCNT+1
.. I (ORAMINR'<ORAMGLO)&(ORAMINR'>ORAMGHI) S ORAMGOOD=ORAMGOOD+1
.. E D
... N ORAMNAME,ORAMSSN,LINE
... S ORAMBAD=ORAMBAD+1,LINE=""
... S ORAMNAME=$P($P(^DPT(ORAMDFN,0),"^"),","),ORAMSSN=$E($P(^DPT(ORAMDFN,0),"^",9),6,9)
... S LINE=$$SETSTR^VALM1(ORAMNAME,LINE,1,15)
... S LINE=$$SETSTR^VALM1("("_ORAMSSN_")",LINE,17,6)
... S LINE=$$SETSTR^VALM1($S(+ORAMINR>0:ORAMINR,1:"N/A"),LINE,25,5)
... S LINE=$$SETSTR^VALM1("("_ORAMGOAL_")",LINE,32,9)
... S RESULT(ORAMBAD)=LINE
I ORAMCNT>0 S ORAMPC=$J(((ORAMGOOD/ORAMCNT)*100),3,1)
I ORAMBAD'="" S ORAMBL=$L(ORAMBAD,"^"),$P(ORAMBAD,"^",1)=ORAMBL
S RESULT(0)=$G(ORAMPC)
Q
;
PTAPPT(RESULT,CLINIC) ; Counts # of pts/day next 45 days
;RPC=ORAM2 PTAPPT
N ORAMFDT,ORAMRDT,ORAMCNT
S ORAMFDT=$$FMADD^XLFDT(DT,45)_".2359",ORAMRDT=DT
F S ORAMRDT=$O(^ORAM(103,"L",ORAMRDT)) Q:(+ORAMRDT'>0)!(ORAMRDT>ORAMFDT) D
. N ORAMDT,ORAMRD,ORAMDFN
. S ORAMDT=$P(ORAMRDT,"."),ORAMRD=$$FMTE^XLFDT(ORAMDT,"2DF"),ORAMDFN=0
. F S ORAMDFN=$O(^ORAM(103,"L",ORAMRDT,ORAMDFN)) Q:'ORAMDFN D
.. N ORAMCLIN S ORAMCLIN=$P($G(^ORAM(103,ORAMDFN,6)),U,2)
.. Q:ORAMCLIN'=$G(CLINIC)
.. S ORAMCNT(ORAMDT)=+$G(ORAMCNT(ORAMDT))+1
.. S RESULT(ORAMDT)=ORAMRD_" - "_$G(ORAMCNT(ORAMDT))
PTAPPTQ Q
;
NOACT(RESULT,DAYS,CLINIC) ; Finds pts w/o AC activity past X days
;RPC=ORAM2 NOACT
N ORAMDT,ORAMFDT,ORAMVST,ORAMDFN,ORAMPT,ORAMSSN,ORAMSORT,ORAMC,ORAMI,ORAMMIS,ORAMLAST,ORAMFS,ORMISVST,ORAMCLIN,ORAMDONE,ORAMFSTA
S ORAMDT=$$NOW^XLFDT,ORAMFDT=$$FMADD^XLFDT(ORAMDT,-DAYS),ORAMDFN=0
F S ORAMDFN=$O(^ORAM(103,ORAMDFN)) Q:+ORAMDFN'>0 D
. S ORAMFS=" ",ORAMLAST=0,ORAMMIS=0,ORAMCLIN=$P($G(^ORAM(103,ORAMDFN,6)),U,2),ORAMDONE=0
. Q:(ORAMCLIN'=$G(CLINIC))!(2=$$GET1^DIQ(103,ORAMDFN,15,"I"))
. F S ORAMFS=$O(^ORAM(103,ORAMDFN,3,ORAMFS),-1) Q:(ORAMFS']"")!ORAMDONE D
.. I '$G(ORAMMIS)&$$MISSED(ORAMDFN,ORAMFS) S ORAMMIS=ORAMFS Q
.. I '$G(ORAMLAST)&'$$MISSED(ORAMDFN,ORAMFS) S ORAMLAST=ORAMFS,ORAMDONE=1
. Q:($$GET1^DIQ(103.011,ORAMLAST_","_ORAMDFN,.01,"I")'<ORAMFDT)
. F ORAMFS="ORAMMIS","ORAMLAST" D
.. K ORMISVST,ORAMFSTA
.. I (ORAMFS="ORAMMIS") S ORMISVST=$$GET1^DIQ(103.011,@ORAMFS_","_ORAMDFN,80,"I"),ORAMFSTA=1
.. Q:(ORAMFS="ORAMMIS")&($G(ORMISVST)'>ORAMFDT)
.. S ORAMFS=@ORAMFS
.. Q:'ORAMFS
.. N LINE S LINE=""
.. S ORAMPT=$P(^DPT(ORAMDFN,0),"^"),ORAMPT=$P(ORAMPT,","),ORAMSSN=$E($P(^DPT(ORAMDFN,0),"^",9),6,9)
.. S ORAMVST=$P(^ORAM(103,ORAMDFN,3,ORAMFS,0),"^")
.. I $G(ORMISVST) S ORAMVST=ORMISVST
.. S LINE=$$SETSTR^VALM1(ORAMPT,LINE,1,15)
.. S LINE=$$SETSTR^VALM1("("_ORAMSSN_")",LINE,17,6)
.. S LINE=$$SETSTR^VALM1($S($G(ORAMFSTA):"Missed Ap: ",1:"Last Seen: ")_$$FMTE^XLFDT($P(ORAMVST,"."),"2DF"),LINE,25,19)
.. S ORAMSORT($P(ORAMVST,"."),ORAMPT_ORAMSSN)=LINE
S (ORAMC,ORAMI)=0
F S ORAMI=$O(ORAMSORT(ORAMI)) Q:+ORAMI'>0 D
. N ORAMJ S ORAMJ=""
. F S ORAMJ=$O(ORAMSORT(ORAMI,ORAMJ)) Q:ORAMJ']"" D
.. S ORAMC=ORAMC+1,RESULT(ORAMC)=$G(ORAMSORT(ORAMI,ORAMJ))
I ORAMC=0 S RESULT(0)="No patients lost to follow-up "_DAYS_" days or longer."
NOACTQ Q
;
MISSED(DFN,FS) ;*354 Added
;Input DFN -> Patient IEN
; FS -> FlowSheet IEN
;Output 1 if this flowsheet entry was a missed appt.
; 0 if this flowsheet entry was not a missed appt.
;
N ORAMCM,IENS,I,RSLT
Q:'$G(DFN)!'$G(FS) 0
S IENS=FS_","_DFN_",",(I,RSLT)=0
I $$GET1^DIQ(103.011,IENS,99,"","ORAMCM")="" Q RSLT
F S I=$O(ORAMCM(I)) Q:'I!RSLT I ORAMCM(I)["Missed Appt; return:" S RSLT=1
Q RSLT
;
SHOWRATE(RESULT,DFN) ; CALCULATES SHOWRATE
;;RPC=ORAM2 NOSHOW
N ORAMFSDT,ORAMFS,ORAMR,ORAMARR,ORAMPC,ORAMSD0,ORAMRDT,ORAMRDT0
S ORAMR=0,ORAMSD0=0,ORAMRDT0=""
S ORAMFSDT=0 F S ORAMFSDT=$O(^ORAM(103,DFN,3,"B",ORAMFSDT)) Q:'ORAMFSDT D
. S ORAMFS=0 F S ORAMFS=$O(^ORAM(103,DFN,3,"B",ORAMFSDT,ORAMFS)) Q:'ORAMFS D
.. N ORAMD0,ORAMSD,ORAMSCR,ORAMPTT,ORAMLCNT,ORAMLLN,ORAMDIFF,FLAG
.. S ORAMD0=$G(^ORAM(103,DFN,3,ORAMFS,0)),ORAMSCR=$P(ORAMD0,"^",13),ORAMSD=$P($P(ORAMD0,"^"),"."),ORAMPTT=$P(ORAMD0,"^",3)
.. S ORAMLCNT=$P($G(^ORAM(103,DFN,3,ORAMFS,1,0)),"^",3) Q:'ORAMLCNT
.. S ORAMLLN=$G(^ORAM(103,DFN,3,ORAMFS,1,ORAMLCNT,0))
.. S ORAMRDT=""
.. S FLAG=$S($G(ORAMLLN)["Next draw:":"N",$G(ORAMLLN)["Callback:":"C",$G(ORAMLLN)["Missed Appt;":"M",1:"Q")
.. I FLAG="Q",ORAMLCNT>1 D ;last comment was maybe split in two lines
... S ORAMLLN=$G(^ORAM(103,DFN,3,ORAMFS,1,ORAMLCNT-1,0))_ORAMLLN ;concatenate last two lines. Various types of splits in data.
... S FLAG=$S($G(ORAMLLN)["Next draw:":"N",$G(ORAMLLN)["Callback:":"C",$G(ORAMLLN)["Missed Appt;":"M",1:"Q")
.. Q:FLAG="Q" ;either malformed or deleted entry
.. I FLAG="N" S ORAMRDT=$P($G(ORAMLLN)," ",3)
.. ;I ORAMRDT="E" S ORAMLCNT=ORAMLCNT-1,ORAMLLN=$G(^ORAM(103,DFN,3,ORAMFS,1,ORAMLCNT,0)) this case is handled by concatenation above
.. ;I S ORAMRDT=$S($G(ORAMLLN)["Next draw:":$P($G(ORAMLLN)," ",3),$G(ORAMLLN)["Callback:":$P($G(ORAMLLN)," ",2),$G(ORAMLLN)["Missed Appt;":"Q",1:$P($G(ORAMLLN)," "))
.. I FLAG="M" S ORAMRDT=$P($G(ORAMLLN)," ",4),ORAMR=ORAMR+1 D DT^DILF("T",ORAMRDT,.ORAMRDT) S ORAMRDT0=ORAMRDT Q ;NOTE PT MISSED DRAW, ADD ONE TO DENOMINATOR
.. I $L(ORAMRDT)>1 D DT^DILF("T",ORAMRDT,.ORAMRDT) ;this probably only works for N flag
.. I FLAG="C" S ORAMRDT=$P($G(ORAMLLN)," ",2) D DT^DILF("T",ORAMRDT,.ORAMRDT) S ORAMRDT=$$FMADD^XLFDT(ORAMRDT,-1)
.. I ($G(ORAMSD0)=$G(ORAMSD)) S ORAMRDT0=ORAMRDT Q ;skip if second appt of the day.
.. S ORAMSD0=ORAMSD
.. I 'ORAMPTT S ORAMRDT0=ORAMRDT Q ;skip if no INR.
.. I ORAMRDT0'="" S ORAMDIFF=$$FMDIFF^XLFDT(ORAMSD,ORAMRDT0,2) S ORAMR=ORAMR+1 I ORAMDIFF<172801 S ORAMARR(0)=$G(ORAMARR(0))+1
.. S ORAMRDT0=ORAMRDT
I ORAMR>0 S ORAMPC=($G(ORAMARR(0))/ORAMR)*100,ORAMPC=$E(ORAMPC,1,4)
S RESULT=$G(ORAMPC)_"^"_$G(ORAMR)
Q
;
RPTSTART(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,MAX,ORFHIE) ;
;;
D START^ORWRP(80,"RPT^ORAM2(.ROOT,.DFN,.ID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.MAX,.ORFHIE)",999)
Q
;
RPT(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,MAX,ORFHIE) ; Generate report for CPRS
D RPT^ORAMX1(.ROOT,$G(DFN),$G(ID),$G(ALPHA),$G(OMEGA),$G(DTRANGE),$G(REMOTE),$G(MAX),$G(ORFHIE))
Q
;
DTCHK(DFN,ALPHA,OMEGA,ORAMFSD) ; CHECKS DATE RANGE WITH ALPHA AND OMEGA FROM CPRS
N ORAMFDT,ORAMVAL
S ORAMVAL=0
S ORAMFDT=$P(^ORAM(103,DFN,3,ORAMFSD,0),"^")
S:ORAMFDT'<ALPHA ORAMVAL=1
S:ORAMFDT>OMEGA ORAMVAL=0
Q ORAMVAL
;
TEAMCHK(RESULT,ORAMTMS) ; SET-UP VERIFY NAMES
;RPC=ORAM2 TEAM CHECK
N ORAMSKIP,ORAMI,ORAMERR
Q:$G(ORAMTMS)=""
F ORAMI=1:1:20 S ORAMSKIP=$G(ORAMSKIP)_" "
S ORAMERR=0
F ORAMI=1:1:$L(ORAMTMS,"^") D
. N ORAMN
. I $P(ORAMTMS,"^",ORAMI)'="" S ORAMN=$P(ORAMTMS,"^",ORAMI) D
.. S RESULT(ORAMI)=ORAMN_$E(ORAMSKIP,1,(20-$L(ORAMN)))
.. I $D(^OR(100.21,ORAMN)) S RESULT(ORAMI)=RESULT(ORAMI)_$P(^OR(100.21,ORAMN,0),"^")
.. E S RESULT(ORAMI)=RESULT(ORAMI)_"clinic not found.",ORAMERR=$G(ORAMERR)+1
S RESULT(0)=$G(ORAMERR)
Q
;
REMIND(RESULT,ORAMDFN,ORAMDT,ORAMREM) ; RPC=ORAM2 REMINDER
N ORAMRML,ORAMDAY,ORAMR,D0,DA,DIK,X
Q:'+$G(ORAMDFN) Q:$G(ORAMDT)="" Q:$G(ORAMREM)=""
S RESULT=0
D NOW^%DTC S ORAMDAY=X D DT^DILF(,ORAMDT,.X) S ORAMDT=X
S $P(^ORAM(103,ORAMDFN,0),"^",18)=$G(ORAMDT)
K ^ORAM(103,ORAMDFN,5)
S ORAMRML=$L(ORAMREM,"^"),^ORAM(103,ORAMDFN,5,0)="^^"_ORAMRML_"^"_ORAMRML_"^"_ORAMDAY_"^"
F ORAMR=1:1:ORAMRML D
. S ^ORAM(103,ORAMDFN,5,ORAMR,0)=$P(ORAMREM,"^",ORAMR)
S DIK="^ORAM(103,",DA=ORAMDFN
D IX^DIK
S RESULT=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORAM2 8956 printed Dec 13, 2024@02:26:59 Page 2
ORAM2 ;POR/RSF - ANTICOAGULATION MANAGEMENT RPCS (3 of 4) ; 1/17/18 6:41pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**307,339,354,361,391,459,451**;Dec 17, 1997;Build 8
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 QUIT
+4 ;
+5 ; External References:
+6 ; $$GET1^DIQ ICR #2056
+7 ; $$SETSTR^VALM1 ICR #10116
+8 ; $$FMADD/$$FMDIFF/$$FMTE/$$NOW^XLFDT ICR #10103
+9 ; $$TITLE/$$UP^XLFSTR ICR #10104
+10 ; $$GET^XPAR ICR #2263
+11 ; ^AUTNPOV( ICR #1593
+12 ;
ALLGOAL(RESULT,DAYS,CLINIC) ; last inr for all pts seen in last x days
+1 ;;RPC = ORAM2 ALLGOAL
+2 NEW ORAMDFN,ORAMNOW,ORAMCUT,ORAMCNT,ORAMPC,ORAMGOOD,ORAMBAD,ORAMBL
+3 SET ORAMDFN=0
SET ORAMCNT=0
SET ORAMGOOD=0
SET ORAMBAD=0
+4 SET ORAMNOW=$$NOW^XLFDT
+5 SET ORAMCUT=$$FMADD^XLFDT(ORAMNOW,-DAYS)
+6 FOR
SET ORAMDFN=$ORDER(^ORAM(103,ORAMDFN))
if 'ORAMDFN
QUIT
Begin DoDot:1
+7 NEW ORAMFS,ORAM3D0,ORAMDATE,ORAMCLIN
+8 SET ORAMFS=$ORDER(^ORAM(103,ORAMDFN,3," "),-1)
if $GET(ORAMFS)=""
QUIT
+9 SET ORAMCLIN=$PIECE($GET(^ORAM(103,ORAMDFN,6)),U,2)
+10 IF +$GET(CLINIC)
IF (ORAMCLIN'=CLINIC)
QUIT
+11 SET ORAM3D0=$GET(^ORAM(103,ORAMDFN,3,ORAMFS,0))
SET ORAMDATE=$PIECE(ORAM3D0,"^")
+12 IF ($GET(ORAMDATE)>$GET(ORAMCUT))
Begin DoDot:2
+13 NEW ORAMINR,ORAMGOAL,ORAMGLO,ORAMGHI
+14 SET ORAMINR=$PIECE(ORAM3D0,"^",3)
SET ORAMGOAL=$PIECE(ORAM3D0,"^",12)
SET ORAMGLO=$PIECE(ORAMGOAL,"-")
SET ORAMGHI=$PIECE(ORAMGOAL,"-",2)
if ORAMGHI[" "
SET ORAMGHI=$PIECE(ORAMGHI," ",2)
+15 SET ORAMGLO=ORAMGLO-(.1*ORAMGLO)
SET ORAMGHI=ORAMGHI+(.1*ORAMGHI)
+16 SET ORAMCNT=ORAMCNT+1
+17 IF (ORAMINR'<ORAMGLO)&(ORAMINR'>ORAMGHI)
SET ORAMGOOD=ORAMGOOD+1
+18 IF '$TEST
Begin DoDot:3
+19 NEW ORAMNAME,ORAMSSN,LINE
+20 SET ORAMBAD=ORAMBAD+1
SET LINE=""
+21 SET ORAMNAME=$PIECE($PIECE(^DPT(ORAMDFN,0),"^"),",")
SET ORAMSSN=$EXTRACT($PIECE(^DPT(ORAMDFN,0),"^",9),6,9)
+22 SET LINE=$$SETSTR^VALM1(ORAMNAME,LINE,1,15)
+23 SET LINE=$$SETSTR^VALM1("("_ORAMSSN_")",LINE,17,6)
+24 SET LINE=$$SETSTR^VALM1($SELECT(+ORAMINR>0:ORAMINR,1:"N/A"),LINE,25,5)
+25 SET LINE=$$SETSTR^VALM1("("_ORAMGOAL_")",LINE,32,9)
+26 SET RESULT(ORAMBAD)=LINE
End DoDot:3
End DoDot:2
End DoDot:1
+27 IF ORAMCNT>0
SET ORAMPC=$JUSTIFY(((ORAMGOOD/ORAMCNT)*100),3,1)
+28 IF ORAMBAD'=""
SET ORAMBL=$LENGTH(ORAMBAD,"^")
SET $PIECE(ORAMBAD,"^",1)=ORAMBL
+29 SET RESULT(0)=$GET(ORAMPC)
+30 QUIT
+31 ;
PTAPPT(RESULT,CLINIC) ; Counts # of pts/day next 45 days
+1 ;RPC=ORAM2 PTAPPT
+2 NEW ORAMFDT,ORAMRDT,ORAMCNT
+3 SET ORAMFDT=$$FMADD^XLFDT(DT,45)_".2359"
SET ORAMRDT=DT
+4 FOR
SET ORAMRDT=$ORDER(^ORAM(103,"L",ORAMRDT))
if (+ORAMRDT'>0)!(ORAMRDT>ORAMFDT)
QUIT
Begin DoDot:1
+5 NEW ORAMDT,ORAMRD,ORAMDFN
+6 SET ORAMDT=$PIECE(ORAMRDT,".")
SET ORAMRD=$$FMTE^XLFDT(ORAMDT,"2DF")
SET ORAMDFN=0
+7 FOR
SET ORAMDFN=$ORDER(^ORAM(103,"L",ORAMRDT,ORAMDFN))
if 'ORAMDFN
QUIT
Begin DoDot:2
+8 NEW ORAMCLIN
SET ORAMCLIN=$PIECE($GET(^ORAM(103,ORAMDFN,6)),U,2)
+9 if ORAMCLIN'=$GET(CLINIC)
QUIT
+10 SET ORAMCNT(ORAMDT)=+$GET(ORAMCNT(ORAMDT))+1
+11 SET RESULT(ORAMDT)=ORAMRD_" - "_$GET(ORAMCNT(ORAMDT))
End DoDot:2
End DoDot:1
PTAPPTQ QUIT
+1 ;
NOACT(RESULT,DAYS,CLINIC) ; Finds pts w/o AC activity past X days
+1 ;RPC=ORAM2 NOACT
+2 NEW ORAMDT,ORAMFDT,ORAMVST,ORAMDFN,ORAMPT,ORAMSSN,ORAMSORT,ORAMC,ORAMI,ORAMMIS,ORAMLAST,ORAMFS,ORMISVST,ORAMCLIN,ORAMDONE,ORAMFSTA
+3 SET ORAMDT=$$NOW^XLFDT
SET ORAMFDT=$$FMADD^XLFDT(ORAMDT,-DAYS)
SET ORAMDFN=0
+4 FOR
SET ORAMDFN=$ORDER(^ORAM(103,ORAMDFN))
if +ORAMDFN'>0
QUIT
Begin DoDot:1
+5 SET ORAMFS=" "
SET ORAMLAST=0
SET ORAMMIS=0
SET ORAMCLIN=$PIECE($GET(^ORAM(103,ORAMDFN,6)),U,2)
SET ORAMDONE=0
+6 if (ORAMCLIN'=$GET(CLINIC))!(2=$$GET1^DIQ(103,ORAMDFN,15,"I"))
QUIT
+7 FOR
SET ORAMFS=$ORDER(^ORAM(103,ORAMDFN,3,ORAMFS),-1)
if (ORAMFS']"")!ORAMDONE
QUIT
Begin DoDot:2
+8 IF '$GET(ORAMMIS)&$$MISSED(ORAMDFN,ORAMFS)
SET ORAMMIS=ORAMFS
QUIT
+9 IF '$GET(ORAMLAST)&'$$MISSED(ORAMDFN,ORAMFS)
SET ORAMLAST=ORAMFS
SET ORAMDONE=1
End DoDot:2
+10 if ($$GET1^DIQ(103.011,ORAMLAST_","_ORAMDFN,.01,"I")'<ORAMFDT)
QUIT
+11 FOR ORAMFS="ORAMMIS","ORAMLAST"
Begin DoDot:2
+12 KILL ORMISVST,ORAMFSTA
+13 IF (ORAMFS="ORAMMIS")
SET ORMISVST=$$GET1^DIQ(103.011,@ORAMFS_","_ORAMDFN,80,"I")
SET ORAMFSTA=1
+14 if (ORAMFS="ORAMMIS")&($GET(ORMISVST)'>ORAMFDT)
QUIT
+15 SET ORAMFS=@ORAMFS
+16 if 'ORAMFS
QUIT
+17 NEW LINE
SET LINE=""
+18 SET ORAMPT=$PIECE(^DPT(ORAMDFN,0),"^")
SET ORAMPT=$PIECE(ORAMPT,",")
SET ORAMSSN=$EXTRACT($PIECE(^DPT(ORAMDFN,0),"^",9),6,9)
+19 SET ORAMVST=$PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),"^")
+20 IF $GET(ORMISVST)
SET ORAMVST=ORMISVST
+21 SET LINE=$$SETSTR^VALM1(ORAMPT,LINE,1,15)
+22 SET LINE=$$SETSTR^VALM1("("_ORAMSSN_")",LINE,17,6)
+23 SET LINE=$$SETSTR^VALM1($SELECT($GET(ORAMFSTA):"Missed Ap: ",1:"Last Seen: ")_$$FMTE^XLFDT($PIECE(ORAMVST,"."),"2DF"),LINE,25,19)
+24 SET ORAMSORT($PIECE(ORAMVST,"."),ORAMPT_ORAMSSN)=LINE
End DoDot:2
End DoDot:1
+25 SET (ORAMC,ORAMI)=0
+26 FOR
SET ORAMI=$ORDER(ORAMSORT(ORAMI))
if +ORAMI'>0
QUIT
Begin DoDot:1
+27 NEW ORAMJ
SET ORAMJ=""
+28 FOR
SET ORAMJ=$ORDER(ORAMSORT(ORAMI,ORAMJ))
if ORAMJ']""
QUIT
Begin DoDot:2
+29 SET ORAMC=ORAMC+1
SET RESULT(ORAMC)=$GET(ORAMSORT(ORAMI,ORAMJ))
End DoDot:2
End DoDot:1
+30 IF ORAMC=0
SET RESULT(0)="No patients lost to follow-up "_DAYS_" days or longer."
NOACTQ QUIT
+1 ;
MISSED(DFN,FS) ;*354 Added
+1 ;Input DFN -> Patient IEN
+2 ; FS -> FlowSheet IEN
+3 ;Output 1 if this flowsheet entry was a missed appt.
+4 ; 0 if this flowsheet entry was not a missed appt.
+5 ;
+6 NEW ORAMCM,IENS,I,RSLT
+7 if '$GET(DFN)!'$GET(FS)
QUIT 0
+8 SET IENS=FS_","_DFN_","
SET (I,RSLT)=0
+9 IF $$GET1^DIQ(103.011,IENS,99,"","ORAMCM")=""
QUIT RSLT
+10 FOR
SET I=$ORDER(ORAMCM(I))
if 'I!RSLT
QUIT
IF ORAMCM(I)["Missed Appt; return:"
SET RSLT=1
+11 QUIT RSLT
+12 ;
SHOWRATE(RESULT,DFN) ; CALCULATES SHOWRATE
+1 ;;RPC=ORAM2 NOSHOW
+2 NEW ORAMFSDT,ORAMFS,ORAMR,ORAMARR,ORAMPC,ORAMSD0,ORAMRDT,ORAMRDT0
+3 SET ORAMR=0
SET ORAMSD0=0
SET ORAMRDT0=""
+4 SET ORAMFSDT=0
FOR
SET ORAMFSDT=$ORDER(^ORAM(103,DFN,3,"B",ORAMFSDT))
if 'ORAMFSDT
QUIT
Begin DoDot:1
+5 SET ORAMFS=0
FOR
SET ORAMFS=$ORDER(^ORAM(103,DFN,3,"B",ORAMFSDT,ORAMFS))
if 'ORAMFS
QUIT
Begin DoDot:2
+6 NEW ORAMD0,ORAMSD,ORAMSCR,ORAMPTT,ORAMLCNT,ORAMLLN,ORAMDIFF,FLAG
+7 SET ORAMD0=$GET(^ORAM(103,DFN,3,ORAMFS,0))
SET ORAMSCR=$PIECE(ORAMD0,"^",13)
SET ORAMSD=$PIECE($PIECE(ORAMD0,"^"),".")
SET ORAMPTT=$PIECE(ORAMD0,"^",3)
+8 SET ORAMLCNT=$PIECE($GET(^ORAM(103,DFN,3,ORAMFS,1,0)),"^",3)
if 'ORAMLCNT
QUIT
+9 SET ORAMLLN=$GET(^ORAM(103,DFN,3,ORAMFS,1,ORAMLCNT,0))
+10 SET ORAMRDT=""
+11 SET FLAG=$SELECT($GET(ORAMLLN)["Next draw:":"N",$GET(ORAMLLN)["Callback:":"C",$GET(ORAMLLN)["Missed Appt;":"M",1:"Q")
+12 ;last comment was maybe split in two lines
IF FLAG="Q"
IF ORAMLCNT>1
Begin DoDot:3
+13 ;concatenate last two lines. Various types of splits in data.
SET ORAMLLN=$GET(^ORAM(103,DFN,3,ORAMFS,1,ORAMLCNT-1,0))_ORAMLLN
+14 SET FLAG=$SELECT($GET(ORAMLLN)["Next draw:":"N",$GET(ORAMLLN)["Callback:":"C",$GET(ORAMLLN)["Missed Appt;":"M",1:"Q")
End DoDot:3
+15 ;either malformed or deleted entry
if FLAG="Q"
QUIT
+16 IF FLAG="N"
SET ORAMRDT=$PIECE($GET(ORAMLLN)," ",3)
+17 ;I ORAMRDT="E" S ORAMLCNT=ORAMLCNT-1,ORAMLLN=$G(^ORAM(103,DFN,3,ORAMFS,1,ORAMLCNT,0)) this case is handled by concatenation above
+18 ;I S ORAMRDT=$S($G(ORAMLLN)["Next draw:":$P($G(ORAMLLN)," ",3),$G(ORAMLLN)["Callback:":$P($G(ORAMLLN)," ",2),$G(ORAMLLN)["Missed Appt;":"Q",1:$P($G(ORAMLLN)," "))
+19 ;NOTE PT MISSED DRAW, ADD ONE TO DENOMINATOR
IF FLAG="M"
SET ORAMRDT=$PIECE($GET(ORAMLLN)," ",4)
SET ORAMR=ORAMR+1
DO DT^DILF("T",ORAMRDT,.ORAMRDT)
SET ORAMRDT0=ORAMRDT
QUIT
+20 ;this probably only works for N flag
IF $LENGTH(ORAMRDT)>1
DO DT^DILF("T",ORAMRDT,.ORAMRDT)
+21 IF FLAG="C"
SET ORAMRDT=$PIECE($GET(ORAMLLN)," ",2)
DO DT^DILF("T",ORAMRDT,.ORAMRDT)
SET ORAMRDT=$$FMADD^XLFDT(ORAMRDT,-1)
+22 ;skip if second appt of the day.
IF ($GET(ORAMSD0)=$GET(ORAMSD))
SET ORAMRDT0=ORAMRDT
QUIT
+23 SET ORAMSD0=ORAMSD
+24 ;skip if no INR.
IF 'ORAMPTT
SET ORAMRDT0=ORAMRDT
QUIT
+25 IF ORAMRDT0'=""
SET ORAMDIFF=$$FMDIFF^XLFDT(ORAMSD,ORAMRDT0,2)
SET ORAMR=ORAMR+1
IF ORAMDIFF<172801
SET ORAMARR(0)=$GET(ORAMARR(0))+1
+26 SET ORAMRDT0=ORAMRDT
End DoDot:2
End DoDot:1
+27 IF ORAMR>0
SET ORAMPC=($GET(ORAMARR(0))/ORAMR)*100
SET ORAMPC=$EXTRACT(ORAMPC,1,4)
+28 SET RESULT=$GET(ORAMPC)_"^"_$GET(ORAMR)
+29 QUIT
+30 ;
RPTSTART(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,MAX,ORFHIE) ;
+1 ;;
+2 DO START^ORWRP(80,"RPT^ORAM2(.ROOT,.DFN,.ID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.MAX,.ORFHIE)",999)
+3 QUIT
+4 ;
RPT(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,MAX,ORFHIE) ; Generate report for CPRS
+1 DO RPT^ORAMX1(.ROOT,$GET(DFN),$GET(ID),$GET(ALPHA),$GET(OMEGA),$GET(DTRANGE),$GET(REMOTE),$GET(MAX),$GET(ORFHIE))
+2 QUIT
+3 ;
DTCHK(DFN,ALPHA,OMEGA,ORAMFSD) ; CHECKS DATE RANGE WITH ALPHA AND OMEGA FROM CPRS
+1 NEW ORAMFDT,ORAMVAL
+2 SET ORAMVAL=0
+3 SET ORAMFDT=$PIECE(^ORAM(103,DFN,3,ORAMFSD,0),"^")
+4 if ORAMFDT'<ALPHA
SET ORAMVAL=1
+5 if ORAMFDT>OMEGA
SET ORAMVAL=0
+6 QUIT ORAMVAL
+7 ;
TEAMCHK(RESULT,ORAMTMS) ; SET-UP VERIFY NAMES
+1 ;RPC=ORAM2 TEAM CHECK
+2 NEW ORAMSKIP,ORAMI,ORAMERR
+3 if $GET(ORAMTMS)=""
QUIT
+4 FOR ORAMI=1:1:20
SET ORAMSKIP=$GET(ORAMSKIP)_" "
+5 SET ORAMERR=0
+6 FOR ORAMI=1:1:$LENGTH(ORAMTMS,"^")
Begin DoDot:1
+7 NEW ORAMN
+8 IF $PIECE(ORAMTMS,"^",ORAMI)'=""
SET ORAMN=$PIECE(ORAMTMS,"^",ORAMI)
Begin DoDot:2
+9 SET RESULT(ORAMI)=ORAMN_$EXTRACT(ORAMSKIP,1,(20-$LENGTH(ORAMN)))
+10 IF $DATA(^OR(100.21,ORAMN))
SET RESULT(ORAMI)=RESULT(ORAMI)_$PIECE(^OR(100.21,ORAMN,0),"^")
+11 IF '$TEST
SET RESULT(ORAMI)=RESULT(ORAMI)_"clinic not found."
SET ORAMERR=$GET(ORAMERR)+1
End DoDot:2
End DoDot:1
+12 SET RESULT(0)=$GET(ORAMERR)
+13 QUIT
+14 ;
REMIND(RESULT,ORAMDFN,ORAMDT,ORAMREM) ; RPC=ORAM2 REMINDER
+1 NEW ORAMRML,ORAMDAY,ORAMR,D0,DA,DIK,X
+2 if '+$GET(ORAMDFN)
QUIT
if $GET(ORAMDT)=""
QUIT
if $GET(ORAMREM)=""
QUIT
+3 SET RESULT=0
+4 DO NOW^%DTC
SET ORAMDAY=X
DO DT^DILF(,ORAMDT,.X)
SET ORAMDT=X
+5 SET $PIECE(^ORAM(103,ORAMDFN,0),"^",18)=$GET(ORAMDT)
+6 KILL ^ORAM(103,ORAMDFN,5)
+7 SET ORAMRML=$LENGTH(ORAMREM,"^")
SET ^ORAM(103,ORAMDFN,5,0)="^^"_ORAMRML_"^"_ORAMRML_"^"_ORAMDAY_"^"
+8 FOR ORAMR=1:1:ORAMRML
Begin DoDot:1
+9 SET ^ORAM(103,ORAMDFN,5,ORAMR,0)=$PIECE(ORAMREM,"^",ORAMR)
End DoDot:1
+10 SET DIK="^ORAM(103,"
SET DA=ORAMDFN
+11 DO IX^DIK
+12 SET RESULT=1
+13 QUIT
+14 ;
