WVRPCPT2 ;ISP/RFR - WV PATIENT FILE (790) APIS AND RPCS ;07/23/2020
;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
Q
CLRSRND(WVDFN,WVTYPE) ;DELETE EVENT(S) THAT TRIGGERED STATUS REVIEW NOTIFICATION
; INPUT: WVDFN - INTERNAL ENTRY NUMBER IN WV PATIENT FILE (#790)
; WVTYPE - TYPE OF SMART DATA
; "P": PREGNANCY
; "L": LACTATION
N WVIEN,WVFDA,WVERROR,WVRETURN
S WVRETURN=1
S WVIEN=0 F S WVIEN=$O(^WV(790.9,"AC",WVDFN,WVTYPE,WVIEN)) Q:'+WVIEN S WVFDA(790.9,WVIEN_",",.01)="@"
Q:'$D(WVFDA) WVRETURN
D FILE^DIE("","WVFDA","WVERROR")
I $D(WVERROR) S WVRETURN=-1_U_"Unable to delete status review event(s): "_$$FMERROR^WVUTL11(.WVERROR)
Q WVRETURN
FINDPROC(WVTMP,WVCNT,WVDFN,WVVISIT,WVDOC,WVNEWDFN,EIE,DOACT) ;
N ACCESS,DA,DATE,END,FIRST,NODE,NOTIF,OCNT,PROC,PUR,SORT,TYPE,WVIEN,WVIIEN,WVNIEN,XREF
;find WV Procedure by documentation IEN
S XREF=""
I WVDOC>0,$D(^WV(790.1,"NOTE",WVDOC)) S XREF="NOTE"
I XREF="",$D(^WV(790.1,"V",WVVISIT)) S XREF="V"
I XREF="" Q
S SORT=$S(XREF="NOTE":WVDOC,1:WVVISIT)
I '$D(^WV(790.1,XREF,SORT)) Q
S OCNT=WVCNT
;
S END=0
S WVIEN=0 F S WVIEN=$O(^WV(790.1,XREF,SORT,WVIEN)) Q:WVIEN'>0!(END=1) D
.S NODE=$G(^WV(790.1,WVIEN,0))
.I $P(NODE,U,36)=1,XREF="NOTE",DOACT=1 D OUTCLEAN(WVIEN,WVDFN,WVDOC,.WVTMP) Q
.I DOACT=0 S WVCNT=WVCNT+1,WVTMP(WVCNT)="The patient next breast treatment data needs to be review in the Women's Package.",END=1 Q
.I '$D(ACCESS) S WVCNT=WVCNT+1,WVTMP(WVCNT)="The following Women's Health accession# need to be reviewed:"
.S WVCNT=WVCNT+1,WVTMP(WVCNT)=" "_$P(NODE,U)
.S WVCNT=WVCNT+1,WVTMP(WVCNT)=" Patient: "_$$GET1^DIQ(2,WVDFN_",",.01)
.S ACCESS($P(NODE,U))=""
.S WVIIEN=0 F S WVIIEN=$O(^WV(790.1,XREF,SORT,WVIEN,WVIIEN)) Q:WVIIEN'>0 D
..S DA(1)=WVIEN,DA=WVIIEN
..I EIE=1 D SETEIE(.DA,WVDOC)
.I EIE=1 D CHKSTAT(WVIEN)
.D FINDNOT(.NOTIF,$P(NODE,U))
I DOACT=0,END=1 Q
;
;write out notification information
S FIRST=0
S WVNIEN=0 F S WVNIEN=$O(NOTIF(WVNIEN)) Q:WVNIEN'>0 D
.S NODE=NOTIF(WVNIEN)
.I FIRST=0 D
..S WVCNT=WVCNT+1,WVTMP(WVCNT)=""
..S WVCNT=WVCNT+1,WVTMP(WVCNT)="The following Women's Health notification need to be reviewed:"
..S FIRST=1
.S NODE=NOTIF(WVNIEN)
.S TYPE=$P($G(^WV(790.403,$P(NODE,U,2),0)),U)
.S PUR=$P($G(^WV(790.404,$P(NODE,U,3),0)),U)
.S DATE=$$FMTE^XLFDT($P(NODE,U))
.S WVCNT=WVCNT+1,WVTMP(WVCNT)=" "_PUR_" notification method "_TYPE_" on "_TYPE
;
I OCNT=WVCNT Q
S WVCNT=WVCNT+1,WVTMP(WVCNT)=""
S WVCNT=WVCNT+1,WVTMP(WVCNT)="Review the patient next treatment due from the Women's Health patient profile."
I +$G(WVNEWDFN)>0 D
.S WVCNT=WVCNT+1,WVTMP(WVCNT)=""
.S WVCNT=WVCNT+1,WVTMP(WVCNT)="Patient note reassign to new patient: "_$$GET1^DIQ(2,WVNEWDFN_",",.01)
.S WVCNT=WVCNT+1,WVTMP(WVCNT)="Review the new patient record for any corrections."
Q
OUTCLEAN(WVIEN,WVDFN,WVDOC,WVTMP) ;
N ACCESS,DA,DIE,IEN,NODE,NOTIF,PAT,WVCNT
S NODE=$G(^WV(790.1,WVIEN,0))
S PAT=$P(NODE,U,2)
S ACCESS=$P(NODE,U) I ACCESS="" Q
D FINDNOT(.NOTIF,ACCESS)
S IEN=0
S DIE="^WV(790.4,"
F S IEN=$O(NOTIF(IEN)) Q:IEN'>0 D
.S DA=IEN,DR=".08///"_DT_";.14///ENTER IN ERROR"
.D ^DIE
S DIE="^WV(790.1,"
S DA=WVIEN,DR=".14///ENTER IN ERROR"
D ^DIE
S DA(1)=DA
S DA=0 F S DA=$O(^WV(790.1,DA(1),10,DA)) Q:DA'>0 D
.D SETEIE(.DA,WVDOC)
S WVCNT=0
S WVCNT=WVCNT+1,WVTMP(WVCNT)="Outside breast care results and notification have been marked Enter in Error Women's Health package"
S WVCNT=WVCNT+1,WVTMP(WVCNT)="for the following patient"
S WVCNT=WVCNT+1,WVTMP(WVCNT)=""
S WVCNT=WVCNT+1,WVTMP(WVCNT)=" "_$$GET1^DIQ(2,PAT_",",.01)
S WVCNT=WVCNT+1,WVTMP(WVCNT)=""
S WVCNT=WVCNT+1,WVTMP(WVCNT)="Review the patient next breast treatment and next treatment due in the Women's Health patient profile."
Q
FINDNOT(NOTIF,ACCESS) ;
N NODE,IEN
S IEN=0 F S IEN=$O(^WV(790.4,"C",ACCESS,IEN)) Q:IEN'>0 D
.S NODE=$G(^WV(790.4,IEN,0))
.S NOTIF(IEN)=$P(NODE,U,2,4)
Q
SETEIE(DA,WVDOC) ;
N DIE,DR
S DIE="^WV(790.1,"_DA(1)_",10,",DR="4///YES"
I +$G(WVDOC)>0,'$D(^TIU(8925,WVDOC)) S DR=DR_";3///@"
D ^DIE
Q
VERDATA(WVRETURN,WVDATA) ;VERIFY DATA FROM CLINICAL REMINDERS
; INPUT: WVRETURN - REFERENCE TO ARRAY IN WHICH TO RETURN STATUS
; [REQUIRED]
; WVDATA - REFERENCE TO ARRAY OF DATA TO SAVE
; [REQUIRED]
; OUTPUT: (0)=1 OR -1
; OUTPUT: (n)=error message
N CNT,WVFILE,WVVALDAT,WVERROR,WVIENS,WVFIELD,WVATTRS
I '$D(WVDATA) S WVRETURN(0)=-1_U_"There is no data to validate." Q
S WVFILE="",CNT=0 F S WVFILE=$O(WVDATA("DATA",WVFILE)) Q:WVFILE="" D
.I "^790^790.05^790.17^790.16^790.9^790.1^790.4^790.23^"'[(U_WVFILE_U) S WVRETURN(1)=-1_U_"Invalid file number: "_WVFILE Q
.I WVFILE=790 D 790(.WVDATA,.CNT,.WVRETURN)
.I WVFILE=790.1 D 7901(.WVDATA,.CNT,.WVRETURN)
.I WVFILE=790.4 D 7904(.WVDATA,.CNT,.WVRETURN)
S WVFILE=1
D CHKIENS^WVRPCPT(.WVDATA),VALS^DIE("","WVDATA(""DATA"")","WVVALDAT","WVERROR")
K WVERROR
S WVFILE=0 F S WVFILE=$O(WVVALDAT(WVFILE)) Q:'+WVFILE D
.I "^790.9^"[(U_WVFILE_U) Q
.S WVIENS="" F S WVIENS=$O(WVVALDAT(WVFILE,WVIENS)) Q:WVIENS="" S WVFIELD=0 F S WVFIELD=$O(WVVALDAT(WVFILE,WVIENS,WVFIELD)) Q:'+WVFIELD D
..Q:$G(WVVALDAT(WVFILE,WVIENS,WVFIELD))'=U
..D FIELD^DID(WVFILE,WVFIELD,"","LABEL;HELP-PROMPT","WVATTRS","WVERROR")
..I $D(WVERROR) S CNT=CNT+1,WVRETURN(CNT)="Field #"_WVFIELD_" in file #"_WVFILE_" has an error: "_$$FMERROR^WVUTL11(.WVERROR) Q
..S CNT=CNT+1,WVRETURN(CNT)="The "_$G(WVATTRS("LABEL"))_" field has an invalid value. "_$G(WVATTRS("HELP-PROMPT"))
S WVRETURN(0)=$S(CNT>0:-1,1:1)
Q
;
790(DATA,CNT,RETURN) ;
K DATA("DATA",790)
Q
;
7901(DATA,CNT,RETURN) ;
N ARRAY,IEN,IENS,SUB,TEMP,X
M ARRAY=DATA("DATA",790.1)
S IENS="" F S IENS=$O(ARRAY(IENS)) Q:IENS="" D
.I IENS[":" D
..K DATA("DATA",790.1,IENS)
..F X=1:1:$L(IENS,":") D
...S IEN=$P(IENS,":",X)
...M DATA("DATA",790.1,IEN)=ARRAY(IENS)
S IENS="" F S IENS=$O(ARRAY(IENS)) Q:IENS="" D
.S SUB="" F S SUB=$O(DATA("DATA",790.1,IENS,SUB)) Q:SUB="" D
..I SUB'>0 K DATA("DATA",790.1,IENS,SUB)
Q
;
7904(DATA,CNT,RETURN) ;
N ARRAY,DELARR,PAT,SUB,TEMP,VALUE
S PAT=DATA("DFN")
S SUB="" F S SUB=$O(DATA("DATA",790.4,SUB)) Q:SUB="" D
.K DATA("DATA",790.4,SUB,.06),DATA("DATA",790.4,SUB,.01)
.I SUB'>0 S TEMP(SUB)="" K DATA("DATA",790.4,SUB)
I +$G(TEMP("F/U DATE"))>0,+$G(TEMP("F/U DATE"))<$$NOW^XLFDT S CNT=CNT+1,RETURN(CNT)="The Follow up date must be greater than now"
Q
;
CHKSTAT(DA) ;
N ALLEIE,DIE,DR,IDX,NODE
S ALLEIE=1
S IDX=0
F S IDX=$O(^WV(790.1,DA,10,IDX)) Q:IDX'>0!(ALLEIE=0) D
.S NODE=$G(^WV(790.1,DA,10,IDX,0))
.I $P(NODE,U,5)'="Y" S ALLEIE=0
I ALLEIE=1 S DIE="^WV(790.1,",DR=".14///OPEN" D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPCPT2 6831 printed Oct 16, 2024@18:48:18 Page 2
WVRPCPT2 ;ISP/RFR - WV PATIENT FILE (790) APIS AND RPCS ;07/23/2020
+1 ;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
+2 QUIT
CLRSRND(WVDFN,WVTYPE) ;DELETE EVENT(S) THAT TRIGGERED STATUS REVIEW NOTIFICATION
+1 ; INPUT: WVDFN - INTERNAL ENTRY NUMBER IN WV PATIENT FILE (#790)
+2 ; WVTYPE - TYPE OF SMART DATA
+3 ; "P": PREGNANCY
+4 ; "L": LACTATION
+5 NEW WVIEN,WVFDA,WVERROR,WVRETURN
+6 SET WVRETURN=1
+7 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790.9,"AC",WVDFN,WVTYPE,WVIEN))
if '+WVIEN
QUIT
SET WVFDA(790.9,WVIEN_",",.01)="@"
+8 if '$DATA(WVFDA)
QUIT WVRETURN
+9 DO FILE^DIE("","WVFDA","WVERROR")
+10 IF $DATA(WVERROR)
SET WVRETURN=-1_U_"Unable to delete status review event(s): "_$$FMERROR^WVUTL11(.WVERROR)
+11 QUIT WVRETURN
FINDPROC(WVTMP,WVCNT,WVDFN,WVVISIT,WVDOC,WVNEWDFN,EIE,DOACT) ;
+1 NEW ACCESS,DA,DATE,END,FIRST,NODE,NOTIF,OCNT,PROC,PUR,SORT,TYPE,WVIEN,WVIIEN,WVNIEN,XREF
+2 ;find WV Procedure by documentation IEN
+3 SET XREF=""
+4 IF WVDOC>0
IF $DATA(^WV(790.1,"NOTE",WVDOC))
SET XREF="NOTE"
+5 IF XREF=""
IF $DATA(^WV(790.1,"V",WVVISIT))
SET XREF="V"
+6 IF XREF=""
QUIT
+7 SET SORT=$SELECT(XREF="NOTE":WVDOC,1:WVVISIT)
+8 IF '$DATA(^WV(790.1,XREF,SORT))
QUIT
+9 SET OCNT=WVCNT
+10 ;
+11 SET END=0
+12 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790.1,XREF,SORT,WVIEN))
if WVIEN'>0!(END=1)
QUIT
Begin DoDot:1
+13 SET NODE=$GET(^WV(790.1,WVIEN,0))
+14 IF $PIECE(NODE,U,36)=1
IF XREF="NOTE"
IF DOACT=1
DO OUTCLEAN(WVIEN,WVDFN,WVDOC,.WVTMP)
QUIT
+15 IF DOACT=0
SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)="The patient next breast treatment data needs to be review in the Women's Package."
SET END=1
QUIT
+16 IF '$DATA(ACCESS)
SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)="The following Women's Health accession# need to be reviewed:"
+17 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=" "_$PIECE(NODE,U)
+18 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=" Patient: "_$$GET1^DIQ(2,WVDFN_",",.01)
+19 SET ACCESS($PIECE(NODE,U))=""
+20 SET WVIIEN=0
FOR
SET WVIIEN=$ORDER(^WV(790.1,XREF,SORT,WVIEN,WVIIEN))
if WVIIEN'>0
QUIT
Begin DoDot:2
+21 SET DA(1)=WVIEN
SET DA=WVIIEN
+22 IF EIE=1
DO SETEIE(.DA,WVDOC)
End DoDot:2
+23 IF EIE=1
DO CHKSTAT(WVIEN)
+24 DO FINDNOT(.NOTIF,$PIECE(NODE,U))
End DoDot:1
+25 IF DOACT=0
IF END=1
QUIT
+26 ;
+27 ;write out notification information
+28 SET FIRST=0
+29 SET WVNIEN=0
FOR
SET WVNIEN=$ORDER(NOTIF(WVNIEN))
if WVNIEN'>0
QUIT
Begin DoDot:1
+30 SET NODE=NOTIF(WVNIEN)
+31 IF FIRST=0
Begin DoDot:2
+32 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=""
+33 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)="The following Women's Health notification need to be reviewed:"
+34 SET FIRST=1
End DoDot:2
+35 SET NODE=NOTIF(WVNIEN)
+36 SET TYPE=$PIECE($GET(^WV(790.403,$PIECE(NODE,U,2),0)),U)
+37 SET PUR=$PIECE($GET(^WV(790.404,$PIECE(NODE,U,3),0)),U)
+38 SET DATE=$$FMTE^XLFDT($PIECE(NODE,U))
+39 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=" "_PUR_" notification method "_TYPE_" on "_TYPE
End DoDot:1
+40 ;
+41 IF OCNT=WVCNT
QUIT
+42 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=""
+43 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)="Review the patient next treatment due from the Women's Health patient profile."
+44 IF +$GET(WVNEWDFN)>0
Begin DoDot:1
+45 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=""
+46 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)="Patient note reassign to new patient: "_$$GET1^DIQ(2,WVNEWDFN_",",.01)
+47 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)="Review the new patient record for any corrections."
End DoDot:1
+48 QUIT
OUTCLEAN(WVIEN,WVDFN,WVDOC,WVTMP) ;
+1 NEW ACCESS,DA,DIE,IEN,NODE,NOTIF,PAT,WVCNT
+2 SET NODE=$GET(^WV(790.1,WVIEN,0))
+3 SET PAT=$PIECE(NODE,U,2)
+4 SET ACCESS=$PIECE(NODE,U)
IF ACCESS=""
QUIT
+5 DO FINDNOT(.NOTIF,ACCESS)
+6 SET IEN=0
+7 SET DIE="^WV(790.4,"
+8 FOR
SET IEN=$ORDER(NOTIF(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+9 SET DA=IEN
SET DR=".08///"_DT_";.14///ENTER IN ERROR"
+10 DO ^DIE
End DoDot:1
+11 SET DIE="^WV(790.1,"
+12 SET DA=WVIEN
SET DR=".14///ENTER IN ERROR"
+13 DO ^DIE
+14 SET DA(1)=DA
+15 SET DA=0
FOR
SET DA=$ORDER(^WV(790.1,DA(1),10,DA))
if DA'>0
QUIT
Begin DoDot:1
+16 DO SETEIE(.DA,WVDOC)
End DoDot:1
+17 SET WVCNT=0
+18 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)="Outside breast care results and notification have been marked Enter in Error Women's Health package"
+19 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)="for the following patient"
+20 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=""
+21 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=" "_$$GET1^DIQ(2,PAT_",",.01)
+22 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=""
+23 SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)="Review the patient next breast treatment and next treatment due in the Women's Health patient profile."
+24 QUIT
FINDNOT(NOTIF,ACCESS) ;
+1 NEW NODE,IEN
+2 SET IEN=0
FOR
SET IEN=$ORDER(^WV(790.4,"C",ACCESS,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^WV(790.4,IEN,0))
+4 SET NOTIF(IEN)=$PIECE(NODE,U,2,4)
End DoDot:1
+5 QUIT
SETEIE(DA,WVDOC) ;
+1 NEW DIE,DR
+2 SET DIE="^WV(790.1,"_DA(1)_",10,"
SET DR="4///YES"
+3 IF +$GET(WVDOC)>0
IF '$DATA(^TIU(8925,WVDOC))
SET DR=DR_";3///@"
+4 DO ^DIE
+5 QUIT
VERDATA(WVRETURN,WVDATA) ;VERIFY DATA FROM CLINICAL REMINDERS
+1 ; INPUT: WVRETURN - REFERENCE TO ARRAY IN WHICH TO RETURN STATUS
+2 ; [REQUIRED]
+3 ; WVDATA - REFERENCE TO ARRAY OF DATA TO SAVE
+4 ; [REQUIRED]
+5 ; OUTPUT: (0)=1 OR -1
+6 ; OUTPUT: (n)=error message
+7 NEW CNT,WVFILE,WVVALDAT,WVERROR,WVIENS,WVFIELD,WVATTRS
+8 IF '$DATA(WVDATA)
SET WVRETURN(0)=-1_U_"There is no data to validate."
QUIT
+9 SET WVFILE=""
SET CNT=0
FOR
SET WVFILE=$ORDER(WVDATA("DATA",WVFILE))
if WVFILE=""
QUIT
Begin DoDot:1
+10 IF "^790^790.05^790.17^790.16^790.9^790.1^790.4^790.23^"'[(U_WVFILE_U)
SET WVRETURN(1)=-1_U_"Invalid file number: "_WVFILE
QUIT
+11 IF WVFILE=790
DO 790(.WVDATA,.CNT,.WVRETURN)
+12 IF WVFILE=790.1
DO 7901(.WVDATA,.CNT,.WVRETURN)
+13 IF WVFILE=790.4
DO 7904(.WVDATA,.CNT,.WVRETURN)
End DoDot:1
+14 SET WVFILE=1
+15 DO CHKIENS^WVRPCPT(.WVDATA)
DO VALS^DIE("","WVDATA(""DATA"")","WVVALDAT","WVERROR")
+16 KILL WVERROR
+17 SET WVFILE=0
FOR
SET WVFILE=$ORDER(WVVALDAT(WVFILE))
if '+WVFILE
QUIT
Begin DoDot:1
+18 IF "^790.9^"[(U_WVFILE_U)
QUIT
+19 SET WVIENS=""
FOR
SET WVIENS=$ORDER(WVVALDAT(WVFILE,WVIENS))
if WVIENS=""
QUIT
SET WVFIELD=0
FOR
SET WVFIELD=$ORDER(WVVALDAT(WVFILE,WVIENS,WVFIELD))
if '+WVFIELD
QUIT
Begin DoDot:2
+20 if $GET(WVVALDAT(WVFILE,WVIENS,WVFIELD))'=U
QUIT
+21 DO FIELD^DID(WVFILE,WVFIELD,"","LABEL;HELP-PROMPT","WVATTRS","WVERROR")
+22 IF $DATA(WVERROR)
SET CNT=CNT+1
SET WVRETURN(CNT)="Field #"_WVFIELD_" in file #"_WVFILE_" has an error: "_$$FMERROR^WVUTL11(.WVERROR)
QUIT
+23 SET CNT=CNT+1
SET WVRETURN(CNT)="The "_$GET(WVATTRS("LABEL"))_" field has an invalid value. "_$GET(WVATTRS("HELP-PROMPT"))
End DoDot:2
End DoDot:1
+24 SET WVRETURN(0)=$SELECT(CNT>0:-1,1:1)
+25 QUIT
+26 ;
790(DATA,CNT,RETURN) ;
+1 KILL DATA("DATA",790)
+2 QUIT
+3 ;
7901(DATA,CNT,RETURN) ;
+1 NEW ARRAY,IEN,IENS,SUB,TEMP,X
+2 MERGE ARRAY=DATA("DATA",790.1)
+3 SET IENS=""
FOR
SET IENS=$ORDER(ARRAY(IENS))
if IENS=""
QUIT
Begin DoDot:1
+4 IF IENS[":"
Begin DoDot:2
+5 KILL DATA("DATA",790.1,IENS)
+6 FOR X=1:1:$LENGTH(IENS,":")
Begin DoDot:3
+7 SET IEN=$PIECE(IENS,":",X)
+8 MERGE DATA("DATA",790.1,IEN)=ARRAY(IENS)
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET IENS=""
FOR
SET IENS=$ORDER(ARRAY(IENS))
if IENS=""
QUIT
Begin DoDot:1
+10 SET SUB=""
FOR
SET SUB=$ORDER(DATA("DATA",790.1,IENS,SUB))
if SUB=""
QUIT
Begin DoDot:2
+11 IF SUB'>0
KILL DATA("DATA",790.1,IENS,SUB)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
7904(DATA,CNT,RETURN) ;
+1 NEW ARRAY,DELARR,PAT,SUB,TEMP,VALUE
+2 SET PAT=DATA("DFN")
+3 SET SUB=""
FOR
SET SUB=$ORDER(DATA("DATA",790.4,SUB))
if SUB=""
QUIT
Begin DoDot:1
+4 KILL DATA("DATA",790.4,SUB,.06),DATA("DATA",790.4,SUB,.01)
+5 IF SUB'>0
SET TEMP(SUB)=""
KILL DATA("DATA",790.4,SUB)
End DoDot:1
+6 IF +$GET(TEMP("F/U DATE"))>0
IF +$GET(TEMP("F/U DATE"))<$$NOW^XLFDT
SET CNT=CNT+1
SET RETURN(CNT)="The Follow up date must be greater than now"
+7 QUIT
+8 ;
CHKSTAT(DA) ;
+1 NEW ALLEIE,DIE,DR,IDX,NODE
+2 SET ALLEIE=1
+3 SET IDX=0
+4 FOR
SET IDX=$ORDER(^WV(790.1,DA,10,IDX))
if IDX'>0!(ALLEIE=0)
QUIT
Begin DoDot:1
+5 SET NODE=$GET(^WV(790.1,DA,10,IDX,0))
+6 IF $PIECE(NODE,U,5)'="Y"
SET ALLEIE=0
End DoDot:1
+7 IF ALLEIE=1
SET DIE="^WV(790.1,"
SET DR=".14///OPEN"
DO ^DIE
+8 QUIT
