- 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 Mar 13, 2025@21:31:57 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 ;
