WVRPCGF2 ;ISP/AGP - APIs for Clinical Reminders ;04/15/2021
;;1.0;WOMEN'S HEALTH;**26**;Sep 30, 1998;Build 624
;
;
CASCADE(RESULT,INPUTS,ID,PAT) ;
N EPISODE
;close reminder episode TODO: needs to be replace with sometype of file driver eventually
S EPISODE("DFN")=PAT
S EPISODE("NAME")=INPUTS("DATA",790.1,ID,"NAME")
;S EPISODE("STATUS")="CLOSED"
D CLOSE^PXRMEOC(.RESULT,.EPISODE)
Q
;
CHECKDAT(WVNODE,PAT,WVFUDATE) ;
I $P(WVNODE,U)'["START AGE" Q
D TERMEVAL(PAT,.WVFUDATE)
Q
;
;set array of future procedure dates and types
GETDATES(WVTRMTS,WVPURP,PAT,WVFUDATE,WVPDATE) ;
N BRDD,BRDD,CRTX,CRDD,DATE,ISMAM,WVNODE
S WVNODE=$G(^WV(790.404,WVPURP,0))
S BRTX=$S($P(WVNODE,U,7)]"":$P(WVNODE,U,7),1:"") ;breast tx need
S BRDD=$S($P(WVNODE,U,8)]"":$P(WVNODE,U,8),1:"") ;breast tx due date
S CRTX=$S($P(WVNODE,U,9)]"":$P(WVNODE,U,9),1:"") ;cervical tx need
S CRDD=$S($P(WVNODE,U,10)]"":$P(WVNODE,U,10),1:"") ;cervical tx due date
S:'$G(WVPDATE) WVPDATE=DT
I BRTX'="" D
.I BRDD="",+$G(WVFUDATE)=0 D CHECKDAT(WVNODE,PAT,.WVFUDATE)
.I BRDD'="",+$G(WVFUDATE)'>0 S DATE=$$FMADD^WVUTL3(BRDD,WVPDATE)
.I $G(WVFUDATE)>0 S DATE=WVFUDATE
.I $D(WVTRMTS("BR",+$G(DATE))) D Q
..I $$ISMAMMO(WVTRMTS("BR",+$G(DATE))) Q
.S WVTRMTS("BR",+$G(DATE))=BRTX
I CRTX'="" D
.I CRDD'="",$G(WVFUDATE)'>0 S DATE=$$FMADD^WVUTL3(BRDD,WVPDATE)
.I $G(WVFUDATE)>0 S DATE=WVFUDATE
.S WVTRMTS("CR",+$G(DATE))=BRTX
Q
;
ISMAMMO(BRTX) ;
Q $S($P($G(^WV(790.51,BRTX,0)),U)["Mammo":1,1:0)
;set the actual future procedure and next treatment dates
;to file 790.
SETDATES(RESULT,WVTRMTS,WVDFN,CLEARNXT) ;
N BRTX,BRDD,CRTX,CRDD,NUM,WVERR,WVFDA
S (BRDD,BRTX,CRDD,CRTX)=""
I $D(WVTRMTS("BR")) D
.S BRDD=$O(WVTRMTS("BR","")) Q:BRDD=""
.S BRTX=$G(WVTRMTS("BR",BRDD)) I BRTX="" S BRDD="" Q
I $D(WVTRMTS("CR")) D
.S CRDD=$O(WVTRMTS("CR","")) Q:CRDD=""
.S CRTX=$G(WVTRMTS("CR",BRDD)) I CRTX="" S CRDD="" Q
I BRDD'="",BRTX'="" D
.I BRDD=0 S BRDD=""
.S WVFDA(790,WVDFN_",",.18)=BRTX
.S WVFDA(790,WVDFN_",",.19)=BRDD
I CRDD'="",CRTX'="" D
.S WVFDA(790,WVDFN_",",.11)=CRTX
.S WVFDA(790,WVDFN_",",.12)=CRDD
I CLEARNXT=1 D
.S WVFDA(790,WVDFN_",",.18)="@"
.S WVFDA(790,WVDFN_",",.19)="@"
I $D(WVFDA) D FILE^DIE("","WVFDA","WVERR")
I $D(WVERR) D
.S RESULT(1)="-1^Error updating the patient future needs"
.S NUM=0
.S NUM=NUM+1,^TMP("PXRMXMZ",$J,NUM,0)="Error adding PATIENT Future needs to the WV PATIENT FILE."
.D BLDMSG^WVRPCGF1(PAT,"Error updating PATIENT Future needs",.NUM)
Q
;
TERMEVAL(PAT,WVFUDATE) ;
N FIEVAL,TERMARR
D TERM^PXRMLDR("VA-WH MAMMOGRAM START DATE",.TERMARR)
D IEVALTER^PXRMTERM(PAT,.TERMARR,.TERMARR,1,.FIEVAL)
I $G(FIEVAL(1))'=1 Q
I $G(FIEVAL(1,"VALUE"))>0 S WVFUDATE=FIEVAL(1,"VALUE")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPCGF2 2795 printed Nov 22, 2024@17:57:30 Page 2
WVRPCGF2 ;ISP/AGP - APIs for Clinical Reminders ;04/15/2021
+1 ;;1.0;WOMEN'S HEALTH;**26**;Sep 30, 1998;Build 624
+2 ;
+3 ;
CASCADE(RESULT,INPUTS,ID,PAT) ;
+1 NEW EPISODE
+2 ;close reminder episode TODO: needs to be replace with sometype of file driver eventually
+3 SET EPISODE("DFN")=PAT
+4 SET EPISODE("NAME")=INPUTS("DATA",790.1,ID,"NAME")
+5 ;S EPISODE("STATUS")="CLOSED"
+6 DO CLOSE^PXRMEOC(.RESULT,.EPISODE)
+7 QUIT
+8 ;
CHECKDAT(WVNODE,PAT,WVFUDATE) ;
+1 IF $PIECE(WVNODE,U)'["START AGE"
QUIT
+2 DO TERMEVAL(PAT,.WVFUDATE)
+3 QUIT
+4 ;
+5 ;set array of future procedure dates and types
GETDATES(WVTRMTS,WVPURP,PAT,WVFUDATE,WVPDATE) ;
+1 NEW BRDD,BRDD,CRTX,CRDD,DATE,ISMAM,WVNODE
+2 SET WVNODE=$GET(^WV(790.404,WVPURP,0))
+3 ;breast tx need
SET BRTX=$SELECT($PIECE(WVNODE,U,7)]"":$PIECE(WVNODE,U,7),1:"")
+4 ;breast tx due date
SET BRDD=$SELECT($PIECE(WVNODE,U,8)]"":$PIECE(WVNODE,U,8),1:"")
+5 ;cervical tx need
SET CRTX=$SELECT($PIECE(WVNODE,U,9)]"":$PIECE(WVNODE,U,9),1:"")
+6 ;cervical tx due date
SET CRDD=$SELECT($PIECE(WVNODE,U,10)]"":$PIECE(WVNODE,U,10),1:"")
+7 if '$GET(WVPDATE)
SET WVPDATE=DT
+8 IF BRTX'=""
Begin DoDot:1
+9 IF BRDD=""
IF +$GET(WVFUDATE)=0
DO CHECKDAT(WVNODE,PAT,.WVFUDATE)
+10 IF BRDD'=""
IF +$GET(WVFUDATE)'>0
SET DATE=$$FMADD^WVUTL3(BRDD,WVPDATE)
+11 IF $GET(WVFUDATE)>0
SET DATE=WVFUDATE
+12 IF $DATA(WVTRMTS("BR",+$GET(DATE)))
Begin DoDot:2
+13 IF $$ISMAMMO(WVTRMTS("BR",+$GET(DATE)))
QUIT
End DoDot:2
QUIT
+14 SET WVTRMTS("BR",+$GET(DATE))=BRTX
End DoDot:1
+15 IF CRTX'=""
Begin DoDot:1
+16 IF CRDD'=""
IF $GET(WVFUDATE)'>0
SET DATE=$$FMADD^WVUTL3(BRDD,WVPDATE)
+17 IF $GET(WVFUDATE)>0
SET DATE=WVFUDATE
+18 SET WVTRMTS("CR",+$GET(DATE))=BRTX
End DoDot:1
+19 QUIT
+20 ;
ISMAMMO(BRTX) ;
+1 QUIT $SELECT($PIECE($GET(^WV(790.51,BRTX,0)),U)["Mammo":1,1:0)
+2 ;set the actual future procedure and next treatment dates
+3 ;to file 790.
SETDATES(RESULT,WVTRMTS,WVDFN,CLEARNXT) ;
+1 NEW BRTX,BRDD,CRTX,CRDD,NUM,WVERR,WVFDA
+2 SET (BRDD,BRTX,CRDD,CRTX)=""
+3 IF $DATA(WVTRMTS("BR"))
Begin DoDot:1
+4 SET BRDD=$ORDER(WVTRMTS("BR",""))
if BRDD=""
QUIT
+5 SET BRTX=$GET(WVTRMTS("BR",BRDD))
IF BRTX=""
SET BRDD=""
QUIT
End DoDot:1
+6 IF $DATA(WVTRMTS("CR"))
Begin DoDot:1
+7 SET CRDD=$ORDER(WVTRMTS("CR",""))
if CRDD=""
QUIT
+8 SET CRTX=$GET(WVTRMTS("CR",BRDD))
IF CRTX=""
SET CRDD=""
QUIT
End DoDot:1
+9 IF BRDD'=""
IF BRTX'=""
Begin DoDot:1
+10 IF BRDD=0
SET BRDD=""
+11 SET WVFDA(790,WVDFN_",",.18)=BRTX
+12 SET WVFDA(790,WVDFN_",",.19)=BRDD
End DoDot:1
+13 IF CRDD'=""
IF CRTX'=""
Begin DoDot:1
+14 SET WVFDA(790,WVDFN_",",.11)=CRTX
+15 SET WVFDA(790,WVDFN_",",.12)=CRDD
End DoDot:1
+16 IF CLEARNXT=1
Begin DoDot:1
+17 SET WVFDA(790,WVDFN_",",.18)="@"
+18 SET WVFDA(790,WVDFN_",",.19)="@"
End DoDot:1
+19 IF $DATA(WVFDA)
DO FILE^DIE("","WVFDA","WVERR")
+20 IF $DATA(WVERR)
Begin DoDot:1
+21 SET RESULT(1)="-1^Error updating the patient future needs"
+22 SET NUM=0
+23 SET NUM=NUM+1
SET ^TMP("PXRMXMZ",$JOB,NUM,0)="Error adding PATIENT Future needs to the WV PATIENT FILE."
+24 DO BLDMSG^WVRPCGF1(PAT,"Error updating PATIENT Future needs",.NUM)
End DoDot:1
+25 QUIT
+26 ;
TERMEVAL(PAT,WVFUDATE) ;
+1 NEW FIEVAL,TERMARR
+2 DO TERM^PXRMLDR("VA-WH MAMMOGRAM START DATE",.TERMARR)
+3 DO IEVALTER^PXRMTERM(PAT,.TERMARR,.TERMARR,1,.FIEVAL)
+4 IF $GET(FIEVAL(1))'=1
QUIT
+5 IF $GET(FIEVAL(1,"VALUE"))>0
SET WVFUDATE=FIEVAL(1,"VALUE")
+6 QUIT
+7 ;
