Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVRPCPT2

WVRPCPT2.m

Go to the documentation of this file. 
  1. 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
  1.  Q
  1. CLRSRND(WVDFN,WVTYPE) ;DELETE EVENT(S) THAT TRIGGERED STATUS REVIEW NOTIFICATION
  1.  ; INPUT: WVDFN - INTERNAL ENTRY NUMBER IN WV PATIENT FILE (#790)
  1.  ;        WVTYPE - TYPE OF SMART DATA
  1.  ;                 "P": PREGNANCY
  1.  ;                 "L": LACTATION
  1.  N WVIEN,WVFDA,WVERROR,WVRETURN
  1.  S WVRETURN=1
  1.  S WVIEN=0 F  S WVIEN=$O(^WV(790.9,"AC",WVDFN,WVTYPE,WVIEN)) Q:'+WVIEN  S WVFDA(790.9,WVIEN_",",.01)="@"
  1.  Q:'$D(WVFDA) WVRETURN
  1.  D FILE^DIE("","WVFDA","WVERROR")
  1.  I $D(WVERROR) S WVRETURN=-1_U_"Unable to delete status review event(s): "_$$FMERROR^WVUTL11(.WVERROR)
  1.  Q WVRETURN
  1. FINDPROC(WVTMP,WVCNT,WVDFN,WVVISIT,WVDOC,WVNEWDFN,EIE,DOACT) ;
  1.  N ACCESS,DA,DATE,END,FIRST,NODE,NOTIF,OCNT,PROC,PUR,SORT,TYPE,WVIEN,WVIIEN,WVNIEN,XREF
  1.  ;find WV Procedure by documentation IEN
  1.  S XREF=""
  1.  I WVDOC>0,$D(^WV(790.1,"NOTE",WVDOC)) S XREF="NOTE"
  1.  I XREF="",$D(^WV(790.1,"V",WVVISIT)) S XREF="V"
  1.  I XREF="" Q
  1.  S SORT=$S(XREF="NOTE":WVDOC,1:WVVISIT)
  1.  I '$D(^WV(790.1,XREF,SORT)) Q
  1.  S OCNT=WVCNT
  1.  ;
  1.  S END=0
  1.  S WVIEN=0 F  S WVIEN=$O(^WV(790.1,XREF,SORT,WVIEN)) Q:WVIEN'>0!(END=1)  D
  1.  .S NODE=$G(^WV(790.1,WVIEN,0))
  1.  .I $P(NODE,U,36)=1,XREF="NOTE",DOACT=1 D OUTCLEAN(WVIEN,WVDFN,WVDOC,.WVTMP) Q
  1.  .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
  1.  .I '$D(ACCESS) S WVCNT=WVCNT+1,WVTMP(WVCNT)="The following Women's Health accession# need to be reviewed:"
  1.  .S WVCNT=WVCNT+1,WVTMP(WVCNT)="   "_$P(NODE,U)
  1.  .S WVCNT=WVCNT+1,WVTMP(WVCNT)="   Patient: "_$$GET1^DIQ(2,WVDFN_",",.01)
  1.  .S ACCESS($P(NODE,U))=""
  1.  .S WVIIEN=0 F  S WVIIEN=$O(^WV(790.1,XREF,SORT,WVIEN,WVIIEN)) Q:WVIIEN'>0  D
  1.  ..S DA(1)=WVIEN,DA=WVIIEN
  1.  ..I EIE=1 D SETEIE(.DA,WVDOC)
  1.  .I EIE=1 D CHKSTAT(WVIEN)
  1.  .D FINDNOT(.NOTIF,$P(NODE,U))
  1.  I DOACT=0,END=1 Q
  1.  ;
  1.  ;write out notification information
  1.  S FIRST=0
  1.  S WVNIEN=0 F  S WVNIEN=$O(NOTIF(WVNIEN)) Q:WVNIEN'>0  D
  1.  .S NODE=NOTIF(WVNIEN)
  1.  .I FIRST=0 D
  1.  ..S WVCNT=WVCNT+1,WVTMP(WVCNT)=""
  1.  ..S WVCNT=WVCNT+1,WVTMP(WVCNT)="The following Women's Health notification need to be reviewed:"
  1.  ..S FIRST=1
  1.  .S NODE=NOTIF(WVNIEN)
  1.  .S TYPE=$P($G(^WV(790.403,$P(NODE,U,2),0)),U)
  1.  .S PUR=$P($G(^WV(790.404,$P(NODE,U,3),0)),U)
  1.  .S DATE=$$FMTE^XLFDT($P(NODE,U))
  1.  .S WVCNT=WVCNT+1,WVTMP(WVCNT)="  "_PUR_" notification method "_TYPE_" on "_TYPE
  1.  ;
  1.  I OCNT=WVCNT Q
  1.  S WVCNT=WVCNT+1,WVTMP(WVCNT)=""
  1.  S WVCNT=WVCNT+1,WVTMP(WVCNT)="Review the patient next treatment due from the Women's Health patient profile."
  1.  I +$G(WVNEWDFN)>0 D
  1.  .S WVCNT=WVCNT+1,WVTMP(WVCNT)=""
  1.  .S WVCNT=WVCNT+1,WVTMP(WVCNT)="Patient note reassign to new patient: "_$$GET1^DIQ(2,WVNEWDFN_",",.01)
  1.  .S WVCNT=WVCNT+1,WVTMP(WVCNT)="Review the new patient record for any corrections."
  1.  Q
  1. OUTCLEAN(WVIEN,WVDFN,WVDOC,WVTMP) ;
  1.  N ACCESS,DA,DIE,IEN,NODE,NOTIF,PAT,WVCNT
  1.  S NODE=$G(^WV(790.1,WVIEN,0))
  1.  S PAT=$P(NODE,U,2)
  1.  S ACCESS=$P(NODE,U) I ACCESS="" Q
  1.  D FINDNOT(.NOTIF,ACCESS)
  1.  S IEN=0
  1.  S DIE="^WV(790.4,"
  1.  F  S IEN=$O(NOTIF(IEN)) Q:IEN'>0  D
  1.  .S DA=IEN,DR=".08///"_DT_";.14///ENTER IN ERROR"
  1.  .D ^DIE
  1.  S DIE="^WV(790.1,"
  1.  S DA=WVIEN,DR=".14///ENTER IN ERROR"
  1.  D ^DIE
  1.  S DA(1)=DA
  1.  S DA=0 F  S DA=$O(^WV(790.1,DA(1),10,DA)) Q:DA'>0  D
  1.  .D SETEIE(.DA,WVDOC)
  1.  S WVCNT=0
  1.  S WVCNT=WVCNT+1,WVTMP(WVCNT)="Outside breast care results and notification have been marked Enter in Error Women's Health package"
  1.  S WVCNT=WVCNT+1,WVTMP(WVCNT)="for the following patient"
  1.  S WVCNT=WVCNT+1,WVTMP(WVCNT)=""
  1.  S WVCNT=WVCNT+1,WVTMP(WVCNT)="  "_$$GET1^DIQ(2,PAT_",",.01)
  1.  S WVCNT=WVCNT+1,WVTMP(WVCNT)=""
  1.  S WVCNT=WVCNT+1,WVTMP(WVCNT)="Review the patient next breast treatment and next treatment due in the Women's Health patient profile."
  1.  Q
  1. FINDNOT(NOTIF,ACCESS) ;
  1.  N NODE,IEN
  1.  S IEN=0 F  S IEN=$O(^WV(790.4,"C",ACCESS,IEN)) Q:IEN'>0  D
  1.  .S NODE=$G(^WV(790.4,IEN,0))
  1.  .S NOTIF(IEN)=$P(NODE,U,2,4)
  1.  Q
  1. SETEIE(DA,WVDOC) ;
  1.  N DIE,DR
  1.  S DIE="^WV(790.1,"_DA(1)_",10,",DR="4///YES"
  1.  I +$G(WVDOC)>0,'$D(^TIU(8925,WVDOC)) S DR=DR_";3///@"
  1.  D ^DIE
  1.  Q
  1. VERDATA(WVRETURN,WVDATA) ;VERIFY DATA FROM CLINICAL REMINDERS
  1.  ; INPUT: WVRETURN - REFERENCE TO ARRAY IN WHICH TO RETURN STATUS
  1.  ;                   [REQUIRED]
  1.  ;        WVDATA - REFERENCE TO ARRAY OF DATA TO SAVE
  1.  ;                 [REQUIRED]
  1.  ;  OUTPUT: (0)=1 OR -1
  1.  ;  OUTPUT: (n)=error message
  1.  N CNT,WVFILE,WVVALDAT,WVERROR,WVIENS,WVFIELD,WVATTRS
  1.  I '$D(WVDATA) S WVRETURN(0)=-1_U_"There is no data to validate." Q
  1.  S WVFILE="",CNT=0 F  S WVFILE=$O(WVDATA("DATA",WVFILE)) Q:WVFILE=""  D
  1.  .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
  1.  .I WVFILE=790 D 790(.WVDATA,.CNT,.WVRETURN)
  1.  .I WVFILE=790.1 D 7901(.WVDATA,.CNT,.WVRETURN)
  1.  .I WVFILE=790.4 D 7904(.WVDATA,.CNT,.WVRETURN)
  1.  S WVFILE=1
  1.  D CHKIENS^WVRPCPT(.WVDATA),VALS^DIE("","WVDATA(""DATA"")","WVVALDAT","WVERROR")
  1.  K WVERROR
  1.  S WVFILE=0 F  S WVFILE=$O(WVVALDAT(WVFILE)) Q:'+WVFILE  D
  1.  .I "^790.9^"[(U_WVFILE_U) Q
  1.  .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
  1.  ..Q:$G(WVVALDAT(WVFILE,WVIENS,WVFIELD))'=U
  1.  ..D FIELD^DID(WVFILE,WVFIELD,"","LABEL;HELP-PROMPT","WVATTRS","WVERROR")
  1.  ..I $D(WVERROR) S CNT=CNT+1,WVRETURN(CNT)="Field #"_WVFIELD_" in file #"_WVFILE_" has an error: "_$$FMERROR^WVUTL11(.WVERROR) Q
  1.  ..S CNT=CNT+1,WVRETURN(CNT)="The "_$G(WVATTRS("LABEL"))_" field has an invalid value. "_$G(WVATTRS("HELP-PROMPT"))
  1.  S WVRETURN(0)=$S(CNT>0:-1,1:1)
  1.  Q
  1.  ;
  1. 790(DATA,CNT,RETURN) ;
  1.  K DATA("DATA",790)
  1.  Q
  1.  ;
  1. 7901(DATA,CNT,RETURN) ;
  1.  N ARRAY,IEN,IENS,SUB,TEMP,X
  1.  M ARRAY=DATA("DATA",790.1)
  1.  S IENS="" F  S IENS=$O(ARRAY(IENS)) Q:IENS=""  D
  1.  .I IENS[":" D
  1.  ..K DATA("DATA",790.1,IENS)
  1.  ..F X=1:1:$L(IENS,":") D
  1.  ...S IEN=$P(IENS,":",X)
  1.  ...M DATA("DATA",790.1,IEN)=ARRAY(IENS)
  1.  S IENS="" F  S IENS=$O(ARRAY(IENS)) Q:IENS=""  D
  1.  .S SUB="" F  S SUB=$O(DATA("DATA",790.1,IENS,SUB)) Q:SUB=""  D
  1.  ..I SUB'>0 K DATA("DATA",790.1,IENS,SUB)
  1.  Q
  1.  ;
  1. 7904(DATA,CNT,RETURN) ;
  1.  N ARRAY,DELARR,PAT,SUB,TEMP,VALUE
  1.  S PAT=DATA("DFN")
  1.  S SUB="" F  S SUB=$O(DATA("DATA",790.4,SUB)) Q:SUB=""  D
  1.  .K DATA("DATA",790.4,SUB,.06),DATA("DATA",790.4,SUB,.01)
  1.  .I SUB'>0 S TEMP(SUB)="" K DATA("DATA",790.4,SUB)
  1.  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"
  1.  Q
  1.  ;
  1. CHKSTAT(DA) ;
  1.  N ALLEIE,DIE,DR,IDX,NODE
  1.  S ALLEIE=1
  1.  S IDX=0
  1.  F  S IDX=$O(^WV(790.1,DA,10,IDX)) Q:IDX'>0!(ALLEIE=0)  D
  1.  .S NODE=$G(^WV(790.1,DA,10,IDX,0))
  1.  .I $P(NODE,U,5)'="Y" S ALLEIE=0
  1.  I ALLEIE=1 S DIE="^WV(790.1,",DR=".14///OPEN" D ^DIE
  1.  Q