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

WV16PST.m

Go to the documentation of this file. 
  1. WV16PST ;HIOFO/FT-WV*1*16 POST INSTALLATION ROUTINE ;6/29/04  11:04
  1.  ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;  #1157 - ^XPDMENU        (supported)
  1.  ;  #2916 - ^DDMOD          (supported)
  1.  ; #10063 - ^%ZTLOAD        (supported)
  1.  ; #10141 - ^XPDUTL         (supported)
  1.  ;
  1. EN ; Start the post-installation
  1.  D EN1,EN2,EN3,EN4
  1.  Q
  1. EN1 ; Add/edit FILE 790.31 entries
  1.  N WVERR,WVFDA,WVIEN
  1.  I $O(^WV(790.31,"B","No Evidence of Malignancy",0))'>0 D  ;exists?
  1.  .S WVFDA(790.31,"+1,",.01)="No Evidence of Malignancy"
  1.  .S WVFDA(790.31,"+1,",.02)=90
  1.  .S WVFDA(790.31,"+1,",.03)=$O(^WV(790.2,"B","MAMMOGRAM DX BILAT",0))
  1.  .S WVFDA(790.31,"+1,",.04)=$O(^WV(790.2,"B","MAMMOGRAM DX UNILAT",0))
  1.  .S WVFDA(790.31,"+1,",.05)=$O(^WV(790.2,"B","MAMMOGRAM SCREENING",0))
  1.  .S WVFDA(790.31,"+1,",.06)=$O(^WV(790.2,"B","PAP SMEAR",0))
  1.  .S WVFDA(790.31,"+1,",.07)=$O(^WV(790.2,"B","BREAST ULTRASOUND",0))
  1.  .S WVFDA(790.31,"+1,",.2)=0
  1.  .S WVFDA(790.31,"+1,",.21)=0
  1.  .S WVIEN=""
  1.  .D UPDATE^DIE("","WVFDA","WVIEN")
  1.  .Q
  1.  K WVDFA,WVIEN
  1.  I $O(^WV(790.31,"B","Abnormal",0))'>0 D  ;exists?
  1.  .S WVFDA(790.31,"+1,",.01)="Abnormal"
  1.  .S WVFDA(790.31,"+1,",.02)=90
  1.  .S WVFDA(790.31,"+1,",.03)=$O(^WV(790.2,"B","MAMMOGRAM DX BILAT",0))
  1.  .S WVFDA(790.31,"+1,",.04)=$O(^WV(790.2,"B","MAMMOGRAM DX UNILAT",0))
  1.  .S WVFDA(790.31,"+1,",.05)=$O(^WV(790.2,"B","MAMMOGRAM SCREENING",0))
  1.  .S WVFDA(790.31,"+1,",.06)=$O(^WV(790.2,"B","PAP SMEAR",0))
  1.  .S WVFDA(790.31,"+1,",.07)=$O(^WV(790.2,"B","BREAST ULTRASOUND",0))
  1.  .S WVFDA(790.31,"+1,",.2)=0
  1.  .S WVFDA(790.31,"+1,",.21)=1
  1.  .S WVIEN=""
  1.  .D UPDATE^DIE("","WVFDA","WVIEN")
  1.  .Q
  1.  ; Add 'BREAST ULTRASOUND' as an associated procedure to 'Unsatisfactory
  1.  ; for Dx'.
  1.  K WVFDA,WVIEN
  1.  S WVIEN=$O(^WV(790.31,"B","Unsatisfactory for Dx",0))
  1.  I WVIEN D
  1.  .S WVFDA(790.31,WVIEN_",",.14)=$O(^WV(790.2,"B","BREAST ULTRASOUND",0))
  1.  .D FILE^DIE("","WVFDA","WVERR")
  1.  .Q
  1.  Q
  1. EN2 ; Option/menu changes
  1.  ; Add WV PAP SMEAR SNOMED CODES to WV MENU-FILE MAINTENANCE menu.
  1.  N WVFLAG,WVMENU,WVOPTION,WVORDER,WVSYN
  1.  S WVMENU="WV MENU-FILE MAINTENANCE"
  1.  S WVOPTION="WV PAP SMEAR SNOMED CODES",WVSYN="PAP",WVORDER=13
  1.  S WVFLAG=$$ADD^XPDMENU(WVMENU,WVOPTION,WVSYN,WVORDER)
  1.  Q
  1. EN3 ; Create and populate AC index on FILE 790.1
  1.  ; task job
  1.  N WVMESAGE,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1.  S ZTRTN="Q4^WV16PST",ZTDESC="WV*1*16 INSTALLATION"
  1.  S ZTIO="",ZTDTH=$H
  1.  D ^%ZTLOAD
  1.  S WVMESAGE="Will build new 'AC' x-ref on FILE 790.1 in background job #"_$G(ZTSK)
  1.  D MES^XPDUTL(WVMESAGE)
  1.  Q
  1. Q4 ; Adding AC Index for WV PROCEDURE file (#790.1)
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  N MSG,RESULT,XREF
  1.  S XREF("FILE")=790.1
  1.  S XREF("ROOT FILE")=790.1
  1.  S XREF("TYPE")="REGULAR"
  1.  S XREF("SHORT DESCR")="Patient and Date of Procedure"
  1.  S XREF("DESCR",1)="This index consists of patient DFN and date of procedure."
  1.  S XREF("DESCR",2)="ex:  ^WV(790.1,'AC',DFN,Date of Procedure,DA)"
  1.  S XREF("USE")="SORTING ONLY"
  1.  S XREF("EXECUTION")="R"
  1.  S XREF("ACTIVITY")="IR"
  1.  S XREF("VAL",1)=.02
  1.  S XREF("VAL",1,"SUBSCRIPT")=1
  1.  S XREF("VAL",2)=.12
  1.  S XREF("VAL",2,"SUBSCRIPT")=2
  1.  S XREF("NAME")="AC"
  1.  D CREIXN^DDMOD(.XREF,"S",.RESULT,"","MSG")
  1.  Q
  1. EN4 ; Add new purposes of notification to FILE 790.404
  1.  N WVFDA,WVIEN,WVLETTER,WVLOOP,WVLOOP1,WVNAME,WVNODE
  1.  D LETTER
  1.  F WVLOOP=1:1 S WVNODE=$T(EN6A+WVLOOP) Q:$P(WVNODE,";",3)=""  D
  1.  .S WVNAME=$P(WVNODE,";",3)
  1.  .Q:WVNAME=""
  1.  .Q:$D(^WV(790.404,"B",WVNAME))  ;already exists
  1.  .K WVFDA
  1.  .S WVFDA(790.404,"+1,",.01)=WVNAME
  1.  .S WVFDA(790.404,"+1,",.04)=1       ;active: 1=yes
  1.  .S WVFDA(790.404,"+1,",.02)=$P(WVNODE,";",4) ;priority code
  1.  .S WVFDA(790.404,"+1,",.06)=$P(WVNODE,";",5) ;result/reminder type
  1.  .S WVFDA(790.404,"+1,",.05)=$P(WVNODE,";",6) ;br or cx type
  1.  .I $P(WVNODE,";",7)]"" D
  1.  ..S WVFDA(790.404,"+1,",.07)=$$BRTXIEN^WVRPCPR1($P(WVNODE,";",7)) ;br tx need
  1.  ..Q
  1.  .I $P(WVNODE,";",8)]"" D
  1.  ..S WVFDA(790.404,"+1,",.08)=$P(WVNODE,";",8) ;br tx due date
  1.  ..Q
  1.  .I $P(WVNODE,";",9)]"" D
  1.  ..S WVFDA(790.404,"+1,",.09)=$$CXTXIEN^WVRPCPR1($P(WVNODE,";",9)) ;cx tx need
  1.  ..Q
  1.  .I $P(WVNODE,";",10)]"" D
  1.  ..S WVFDA(790.404,"+1,",.1)=$P(WVNODE,";",10) ;cx tx due date
  1.  ..Q
  1.  .K WVIEN
  1.  .D UPDATE^DIE("","WVFDA","WVIEN")
  1.  .Q:+$G(WVLETTER(0))'>0  ;copy generic letter text for new purpose
  1.  .S WVLOOP1=0
  1.  .S ^WV(790.404,WVIEN(1),1,0)="^^"_WVLETTER(0)_U_WVLETTER(0)_U_DT
  1.  .F WVLOOP1=1:1:WVLETTER(0) D
  1.  ..S ^WV(790.404,WVIEN(1),1,WVLOOP1,0)=WVLETTER(WVLOOP1)
  1.  ..Q
  1.  .Q
  1.  Q
  1.  ;;(3)name;(4)priority;(5)result/reminder;(6)br/cx;(7)br tx need;(8)br tx due date;(9)cx tx need;(10)cx tx due date
  1. EN6A ;New purposes of notification
  1.  ;;CPRS UPDATE PAP TX NEED 4M;2;0;CX;;;Repeat PAP;4M
  1.  ;;CPRS UPDATE PAP TX NEED 6M;2;0;CX;;;Repeat PAP;6M
  1.  ;;CPRS UPDATE PAP TX NEED 3Y;3;0;CX;;;Routine PAP;3Y
  1.  ;;CPRS UPDATE PAP TX NEED 2Y;3;0;CX;;;Routine PAP;2Y
  1.  ;;CPRS UPDATE PAP TX NEED 1Y;3;0;CX;;;Routine PAP;1Y
  1.  ;;CPRS UPDATE MAM TX NEED 1Y;3;0;BR;Mammogram, Screening;1Y;;
  1.  ;;CPRS UPDATE MAM TX NEED 2Y;3;0;BR;Mammogram, Screening;2Y;;
  1.  ;;CPRS UPDATE MAM TX NEED 6M;2;0;BR;Mammogram, Repeat;6M;;
  1.  ;;CPRS UPDATE MAM TX NEED 4M;2;0;BR;Mammogram, Repeat;4M;;
  1.  ;;MAM result NEM, next MAM 1Y;3;1;BR;Mammogram, Screening;1Y;;
  1.  ;;MAM result NEM, next MAM 2Y;3;1;BR;Mammogram, Screening;2Y;;
  1.  ;;MAM result NEM, next MAM 4M;2;1;BR;Mammogram, Repeat;4M;;
  1.  ;;MAM result NEM, next MAM 6M;2;1;BR;Mammogram, Repeat;6M;;
  1.  ;;MAM result abnormal, F/U MAM 4M;2;1;BR;Mammogram, Followup;4M;;
  1.  ;;MAM result abnormal, F/U MAM 6M;2;1;BR;Mammogram, Followup;6M;;
  1.  ;;PAP result NEM, next PAP 1Y;3;1;CX;;;Routine PAP;1Y
  1.  ;;PAP result NEM, next PAP 2Y;3;1;CX;;;Routine PAP;2Y
  1.  ;;PAP result NEM, next PAP 3Y;3;1;CX;;;Routine PAP;3Y
  1.  ;;PAP result NEM, next PAP 4M;2;1;CX;;;Repeat PAP;4M
  1.  ;;PAP result NEM, next PAP 6M;2;1;CX;;;Repeat PAP;6M
  1.  ;;PAP result abnormal, F/U PAP 4M;2;1;CX;;;Follow-up PAP;4M
  1.  ;;PAP result abnormal, F/U PAP 6M;2;1;CX;;;Follow-up PAP;6M
  1.  ;;MAM unsatisfactory, need repeat;2;1;BR;Mammogram, Repeat;0D;;
  1.  ;;Pap unsatisfactory, need repeat;2;1;CX;;;Repeat PAP;0D
  1.  ;;PAP result NEM, further screening not required;3;1;CX;;;;
  1.  ;;MAM result NEM, further screening not required;3;1;BR;;;;
  1.  ;;;
  1.  Q
  1. LETTER ; Copy generic letter text into local array
  1.  N WVCOUNT,WVLOOP,WVNODE
  1.  K WVLETTER
  1.  S (WVCOUNT,WVLOOP)=0
  1.  F WVLOOP=1:1 S WVNODE=$T(LTRTEXT+WVLOOP) Q:$P(WVNODE,";",3)=""  D
  1.  .S WVCOUNT=WVCOUNT+1
  1.  .S WVLETTER(WVCOUNT)=$P(WVNODE,";",3)
  1.  .Q
  1.  S WVLETTER(0)=WVCOUNT
  1.  Q
  1. LTRTEXT ;;Generic letter text
  1.  ;;|NOWRAP|;
  1.  ;; ;
  1.  ;;|CENTER("Women's Health Clinic")|;
  1.  ;; ;
  1.  ;;|CENTER("Your Street")|;
  1.  ;; ;
  1.  ;;|CENTER("Your City, ST  Zip Code")|;
  1.  ;; ;
  1.  ;; ;
  1.  ;;     |TODAY|;
  1.  ;; ;
  1.  ;; ;
  1.  ;;                                                       |$E(SSN#,6,9)|;
  1.  ;;     |$P(NAME,",",2)| |$P(NAME,",")|;
  1.  ;;     |COMPLETE ADDRESS|;
  1.  ;; ;
  1.  ;; ;
  1.  ;; ;
  1.  ;; ;
  1.  ;; ;
  1.  ;;- -                                                                    - -;
  1.  ;; ;
  1.  ;;     Dear Ms. |$P(NAME,",",1)|,;
  1.  ;; ;
  1.  ;;     This is the body of the letter and should be edited to say what;
  1.  ;;     you want for this Purpose of Notification.;
  1.  ;; ;
  1.  ;; ;
  1.  ;;     Sincerely,;
  1.  ;; ;
  1.  ;; ;
  1.  ;; ;
  1.  ;;     Your Name;
  1.  ;;     Women's Health Program;
  1.  ;;     phone: nnn-nnnn;
  1.  ;; ;
  1.  ;; ;
  1.  ;;     printed: |NOW|;
  1.  ;;;