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

WV1026P.m

Go to the documentation of this file. 
  1. WV1026P ;ISP/AGP - PATCH 26 INSTALLATION TASKS;Feb 01, 2021@15:37
  1.  ;;1.0;WOMEN'S HEALTH;**26**;Sep 30, 1998;Build 624
  1.  Q
  1.  ;
  1. BLDARRAY(ARRAY) ;
  1.  S ARRAY("BR 0 BIOPSY ALREADY OBTAIN")="BREAST BIOPSY ALREADY OBTAIN"
  1.  S ARRAY("BR BIRAD 0 CONSULT")="BREAST CONSULT"
  1.  S ARRAY("BR 0 CURRENTLY UNDER TREATMENT")="BREAST CURRENTLY UNDER TREATMENT"
  1.  S ARRAY("BR BIRAD 1, need Mammogram")="BREAST NEED MAMMOGRAM"
  1.  S ARRAY("BR BIRAD 1, need MRI")="BREAST NEED MRI"
  1.  S ARRAY("BR BIRAD 1, need Ultrasound")="BREAST NEED ULTRASOUND"
  1.  S ARRAY("BR BIRAD 0 OBTAIN PRIOR FILMS")="BREAST OBTAIN PRIOR FILMS"
  1.  S ARRAY("BR 0 REFER FOR BIOPSY")="BREAST REFER FOR BIOPSY"
  1.  S ARRAY("BR 0 REFER TO ONCOLOGIST")="BREAST REFER TO ONCOLOGIST"
  1.  S ARRAY("BR 0 REFER TO SURGEON")="BREAST REFER TO SURGEON"
  1.  ;S ARRAY("BR BIRAD 1, next MAM AGE AT START AGE")="BR BIRAD 1, next MAM AT START AGE"
  1.  ;S ARRAY("BR BIRAD 2, next MAM AGE AT START AGE")="BR BIRAD 2, next MAM AT START AGE"
  1.  S ARRAY("BR BIRAD 1, next MAM AGE 1Y")="BREAST next MAM 1Y"
  1.  S ARRAY("BR BIRAD 1, next MAM AGE 2Y")="BREAST next MAM 2Y"
  1.  S ARRAY("BR BIRAD 1, next MAM AT START AGE")="BREAST next MAM AT START AGE"
  1.  Q
  1. GETLIST(ARRAY,WHAT) ;
  1.  N LINE
  1.  I WHAT="PURPOSE" D  Q
  1.  .F LINE=1:1 Q:$L($T(PURLIST+LINE))<3  D
  1.  ..N TEXT
  1.  ..S TEXT=$P($T(PURLIST+LINE),";;",2)
  1.  ..S ARRAY(TEXT)=""
  1.  Q
  1.  ;
  1. PATDATES ;
  1.  N ARRAY,ACTNODE,IEN,NAME,NODE,NOTE,PATS,PROC,WVFUDATE,WVFDA,WVERR,WVIEN
  1.  D BMES^XPDUTL("Update Women's Health Patient record that need Next Breast Treatment Date")
  1.  D BMES^XPDUTL("  Find Procedure to review")
  1.  S IEN=$O(^WV(790.51,"B","Mammogram, Screening",""))
  1.  I IEN>0 S ARRAY(IEN)=""
  1.  S IEN=$O(^WV(790.51,"B","BREAST TOMOSYNTHESIS SCREENING",""))
  1.  I IEN>0 S ARRAY(IEN)=""
  1.  I '$D(ARRAY) Q
  1.  ;find patients that need to be reviewed
  1.  D BMES^XPDUTL("  Find Patients to review")
  1.  S NOTE="" F  S NOTE=$O(^WV(790.1,"NOTE",NOTE)) Q:NOTE=""  D
  1.  .S WVIEN=0 F  S WVIEN=$O(^WV(790.1,"NOTE",NOTE,WVIEN)) Q:WVIEN'>0  D
  1.  ..S NODE=$G(^WV(790.1,WVIEN,0))
  1.  ..S IEN=0
  1.  ..F  S IEN=$O(^WV(790.1,WVIEN,10,IEN)) Q:IEN'>0  D
  1.  ...S ACTNODE=$G(^WV(790.1,WVIEN,10,IEN,0))
  1.  ...I $P(ACTNODE,U,5)="Y" Q
  1.  ...I $P(ACTNODE,U)'="Return to Age Based Screening" Q
  1.  ...S PATS(+$P(NODE,U,2))=""
  1.  ;loop through patients for review
  1.  D BMES^XPDUTL("  Review Patients record")
  1.  S IEN=0 F  S IEN=$O(PATS(IEN)) Q:IEN'>0  D
  1.  .I '$$UNDERAGE(IEN) Q
  1.  .S NODE=$G(^WV(790,IEN,0))
  1.  .S PROC=$P(NODE,U,18) I +PROC=0 Q
  1.  .I '$D(ARRAY(PROC)) Q
  1.  .I +$P(NODE,U,19)>0 Q
  1.  .S NAME=$$GET1^DIQ(2,IEN,.01)
  1.  .I NAME="" Q
  1.  .S WVFUDATE=""
  1.  .D TERMEVAL^WVRPCGF2(IEN,.WVFUDATE)
  1.  .I WVFUDATE="" Q
  1.  .D BMES^XPDUTL("   Updating patient "_NAME)
  1.  .S WVFDA(790,IEN_",",.19)=WVFUDATE
  1.  .D FILE^DIE("","WVFDA","WVERR")
  1.  .I $D(WVERR) D
  1.  ..D BMES^XPDUTL("   Error updating record")
  1.  ..D AWRITE^PXRMUTIL("WVERR")
  1.  Q
  1.  ;
  1. PRE ;
  1.  N WVMSG
  1.  S WVMSG(1)="  Removing the data dictionary for the "
  1.  S WVMSG(2)="    WV PREGNANCY/LACTATION STATUS CONFLICT EVENTS file (#790.9)..."
  1.  D BMES^XPDUTL(.WVMSG)
  1.  N DIU
  1.  S DIU=790.9,DIU(0)=""
  1.  D EN^DIU2
  1.  D MES^XPDUTL("    DONE")
  1.  Q
  1. POST ;
  1.  D RENAME,PATDATES,REINDEX,CLEAR
  1.  Q
  1.  ;
  1. RENAME ;
  1.  N ARRAY,NAME,NEWNAME
  1.  D BLDARRAY(.ARRAY)
  1.  S NAME="" F  S NAME=$O(ARRAY(NAME)) Q:NAME=""  D
  1.  .S NEWNAME=ARRAY(NAME)
  1.  .D RENAME^PXRMUTIL(790.404,NAME,NEWNAME)
  1.  Q
  1.  ;
  1. UNDERAGE(DFN) ;
  1.  N AGE,DOB
  1.  I +$P($G(^DPT(DFN,.35)),U,1)>0 Q 0
  1.  S DOB=$P(^DPT(DFN,0),U,3)
  1.  S AGE=(DT-DOB)\10000
  1.  I AGE>44 Q 0
  1.  Q 1
  1.  ;
  1. SENDPUR(ANAME) ;
  1.  N ARRAY
  1.  D GETLIST(.ARRAY,"PURPOSE")
  1.  I $D(ARRAY(ANAME)) Q 1
  1.  Q 0
  1.  ;
  1. REINDEX ; Rebuild the APREG index in the WV PATIENT file (#790)
  1.  D BMES^XPDUTL("  Rebuilding the APREG index...")
  1.  N WVDFN
  1.  S WVDFN=0 F  S WVDFN=$O(^WV(790,WVDFN)) Q:'+WVDFN  D
  1.  .N WVINDEX
  1.  .K ^WV(790,WVDFN,4,"APREG")
  1.  .D PREGS^WVUTL11(WVDFN,.WVINDEX)
  1.  D MES^XPDUTL("    DONE")
  1.  Q
  1.  ; 
  1. CLEAR ; Clear the Cover Sheet data cache for all patients
  1.  D BMES^XPDUTL("  Clearing the CPRS Cover Sheet data cache...")
  1.  N WVSUB
  1.  S WVSUB="WV_CCS;" F  S WVSUB=$O(^XTMP(WVSUB)) Q:$E(WVSUB,1,7)'="WV_CCS;"  D
  1.  .K ^XTMP(WVSUB)
  1.  D MES^XPDUTL("    DONE")
  1.  Q
  1.  ;
  1. PURLIST ;
  1.  ;;BI-RAD 0 DENSE RESULT
  1.  ;;BI-RAD 0 RESULT
  1.  ;;BI-RAD 1 DENSE RESULT
  1.  ;;BI-RAD 1 RESULT
  1.  ;;BI-RAD 2 DENSE RESULT
  1.  ;;BI-RAD 2 RESULT
  1.  ;;BI-RAD 3 DENSE RESULT
  1.  ;;BI-RAD 3 RESULT
  1.  ;;BI-RAD 4 DENSE RESULT
  1.  ;;BI-RAD 4 RESULT
  1.  ;;BI-RAD 5 DENSE RESULT
  1.  ;;BI-RAD 5 RESULT
  1.  ;;BI-RAD 6 DENSE RESULT
  1.  ;;BI-RAD 6 RESULT
  1.  ;;BREAST ABNORMAL DENSE RESULT
  1.  ;;BREAST ABNORMAL RESULT
  1.  ;;BREAST NORMAL DENSE RESULT
  1.  ;;BREAST NORMAL RESULT
  1.  ;;BREAST UNSATISFACTORY DENSE RESULT
  1.  ;;BREAST UNSATISFACTORY RESULT
  1.  ;;BREAST NEED MAMMOGRAM
  1.  ;;BREAST NEED MRI
  1.  ;;BREAST NEED ULTRASOUND
  1.  ;;BREAST next MAM AT START AGE
  1.  Q
  1.  ;