WVRPCPD ;SPFO/LMT - API/RPC TX Needs Due ;01/23/2017 11:17
;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
;
PROCDUE(WVRESULT,WVPROCTYP,WVPROCARR,WVDATE) ;
;
; Returns list of patient's with procedure(s) due. Excludes
; inactive WV PATIENTs and deceased patients.
;
;Input:
; WVPROCTYP - Procedure Type ("BR" or "CX"). Optional, defaults to "BR".
; WVPROCARR - Array of Procedure(s) (i.e., array of IENs from 790.51 (for
; "BR") or file 790.5 (for "CX")). Optional, defaults to all
; procedures, except "Not Indicated".
; WVDATE - Date to use determine if procedure is due. Any due date
; equal to WVDATE will be considered due. Optional,
; defaults to DT.
;
;Returns:
; @WVRESULT@(0)=Count
; @WVRESULT@(n)=DFN ^ Procedure ^ Procedure Due Date
;
N DFN,WV790,WVCNT,WVFILE,WVFLD,WVFLDDT,WVNODE0,WVPROC,WVPROCDT,WVTXNI
;
S WVRESULT=$NA(^TMP("WVPROCDUE",$J))
K ^TMP("WVPROCDUE",$J)
S WVCNT=0
;
I $G(WVPROCTYP)'?1(1"BR",1"CX") S WVPROCTYP="BR"
I '$G(WVDATE) S WVDATE=DT
;
S WV790=0
F S WV790=$O(^WV(790,WV790)) Q:'WV790 D
. S WVNODE0=$G(^WV(790,WV790,0))
. S DFN=$P(WVNODE0,U)
. ;
. ;if patient is inactive, quit
. I $P(WVNODE0,U,24) Q
. ;
. ;If patient is deceased, set inactive date to date of death and quit
. I $$DECEASED^WVUTL1(DFN) D Q
. . N DA,DR,DIE,X,Y
. . S DIE="^WV(790,",DA=WV790
. . S DR=".24////"_$P($$GET1^DIQ(2,DFN,.351,"I"),".") ;date only
. . D ^DIE
. ;
. S WVFLD=18
. S WVFLDDT=19
. S WVFILE=790.51
. I WVPROCTYP="CX" D
. . S WVFLD=11
. . S WVFLDDT=12
. . S WVFILE=790.5
. S WVTXNI=$$IEN^WVUTL9(WVFILE,"Not Indicated")
. ;
. S WVPROC=$P(WVNODE0,U,WVFLD)
. I WVPROC="" Q
. S WVPROCDT=$P(WVNODE0,U,WVFLDDT)
. I WVPROCDT="" Q
. ;
. ; if only searching for specific procedures, quit if this
. ; procedure is not included in the search.
. I $O(WVPROCARR(0)),'$D(WVPROCARR(WVPROC)) Q
. ;
. ; if searching for all procedures, exclude "Not Indicated"
. I '$O(WVPROCARR(0)),WVPROC=WVTXNI Q
. ;
. I WVPROCDT'=WVDATE Q
. ;
. S WVCNT=WVCNT+1
. S ^TMP("WVPROCDUE",$J,WVCNT)=DFN_U_WVPROC_U_WVPROCDT
;
S ^TMP("WVPROCDUE",$J,0)=WVCNT
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPCPD 2242 printed Apr 09, 2024@21:48:55 Page 2
WVRPCPD ;SPFO/LMT - API/RPC TX Needs Due ;01/23/2017 11:17
+1 ;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
+2 ;
PROCDUE(WVRESULT,WVPROCTYP,WVPROCARR,WVDATE) ;
+1 ;
+2 ; Returns list of patient's with procedure(s) due. Excludes
+3 ; inactive WV PATIENTs and deceased patients.
+4 ;
+5 ;Input:
+6 ; WVPROCTYP - Procedure Type ("BR" or "CX"). Optional, defaults to "BR".
+7 ; WVPROCARR - Array of Procedure(s) (i.e., array of IENs from 790.51 (for
+8 ; "BR") or file 790.5 (for "CX")). Optional, defaults to all
+9 ; procedures, except "Not Indicated".
+10 ; WVDATE - Date to use determine if procedure is due. Any due date
+11 ; equal to WVDATE will be considered due. Optional,
+12 ; defaults to DT.
+13 ;
+14 ;Returns:
+15 ; @WVRESULT@(0)=Count
+16 ; @WVRESULT@(n)=DFN ^ Procedure ^ Procedure Due Date
+17 ;
+18 NEW DFN,WV790,WVCNT,WVFILE,WVFLD,WVFLDDT,WVNODE0,WVPROC,WVPROCDT,WVTXNI
+19 ;
+20 SET WVRESULT=$NAME(^TMP("WVPROCDUE",$JOB))
+21 KILL ^TMP("WVPROCDUE",$JOB)
+22 SET WVCNT=0
+23 ;
+24 IF $GET(WVPROCTYP)'?1(1"BR",1"CX")
SET WVPROCTYP="BR"
+25 IF '$GET(WVDATE)
SET WVDATE=DT
+26 ;
+27 SET WV790=0
+28 FOR
SET WV790=$ORDER(^WV(790,WV790))
if 'WV790
QUIT
Begin DoDot:1
+29 SET WVNODE0=$GET(^WV(790,WV790,0))
+30 SET DFN=$PIECE(WVNODE0,U)
+31 ;
+32 ;if patient is inactive, quit
+33 IF $PIECE(WVNODE0,U,24)
QUIT
+34 ;
+35 ;If patient is deceased, set inactive date to date of death and quit
+36 IF $$DECEASED^WVUTL1(DFN)
Begin DoDot:2
+37 NEW DA,DR,DIE,X,Y
+38 SET DIE="^WV(790,"
SET DA=WV790
+39 ;date only
SET DR=".24////"_$PIECE($$GET1^DIQ(2,DFN,.351,"I"),".")
+40 DO ^DIE
End DoDot:2
QUIT
+41 ;
+42 SET WVFLD=18
+43 SET WVFLDDT=19
+44 SET WVFILE=790.51
+45 IF WVPROCTYP="CX"
Begin DoDot:2
+46 SET WVFLD=11
+47 SET WVFLDDT=12
+48 SET WVFILE=790.5
End DoDot:2
+49 SET WVTXNI=$$IEN^WVUTL9(WVFILE,"Not Indicated")
+50 ;
+51 SET WVPROC=$PIECE(WVNODE0,U,WVFLD)
+52 IF WVPROC=""
QUIT
+53 SET WVPROCDT=$PIECE(WVNODE0,U,WVFLDDT)
+54 IF WVPROCDT=""
QUIT
+55 ;
+56 ; if only searching for specific procedures, quit if this
+57 ; procedure is not included in the search.
+58 IF $ORDER(WVPROCARR(0))
IF '$DATA(WVPROCARR(WVPROC))
QUIT
+59 ;
+60 ; if searching for all procedures, exclude "Not Indicated"
+61 IF '$ORDER(WVPROCARR(0))
IF WVPROC=WVTXNI
QUIT
+62 ;
+63 IF WVPROCDT'=WVDATE
QUIT
+64 ;
+65 SET WVCNT=WVCNT+1
+66 SET ^TMP("WVPROCDUE",$JOB,WVCNT)=DFN_U_WVPROC_U_WVPROCDT
End DoDot:1
+67 ;
+68 SET ^TMP("WVPROCDUE",$JOB,0)=WVCNT
+69 ;
+70 QUIT
