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

WVRPCNO1.m

Go to the documentation of this file.
  1. WVRPCNO1 ;HIOFO/FT-WV PRINT LETTERS. ;8/21/03 13:37
  1. ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
  1. ;
  1. ; This routine uses the following IAs:
  1. ; #10063 - ^%ZTLOAD call (supported)
  1. ; #10103 - ^XLFDT calls (supported)
  1. ; #10104 - ^XLFSTR calls (supported)
  1. ;
  1. ; The following entry point(s) are documented by IAs:
  1. ; LETTER - 4103 (private)
  1. ;
  1. DEVICE(WVDA,WVPRINTR) ; Queue to TaskMan to print letter
  1. N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
  1. S ZTDESC="Print Women's Health letter"
  1. S ZTDTH=$$NOW^XLFDT()
  1. S ZTIO=WVPRINTR
  1. S ZTRTN="PRINT^WVRPCNO1"
  1. S ZTSAVE("WVDA")=""
  1. D ^%ZTLOAD
  1. Q
  1. PRINT ; Print notification letter, update treatment needs & due dates
  1. ; required variable: wvda=ien in ^WV(790.4,
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. N BY,DIWF,WVDFN,WVKDT,WVPURP
  1. S IOP=ION
  1. S WVDFN=$P(^WV(790.4,WVDA,0),U)
  1. S WVPURP=$P(^WV(790.4,WVDA,0),U,4)
  1. S:'$D(WVKDT) WVKDT=$P(^WV(790.4,WVDA,0),U,11)
  1. ; if no purpose (deleted), kill "aprt" xref and quit.
  1. I 'WVPURP D Q
  1. .D KILLXREF^WVLETPR(WVDA,WVKDT)
  1. S DIWF="^WV(790.404,WVPURP,1,"
  1. S DIWF(1)=790
  1. S BY="INTERNAL(#.01)="_WVDFN
  1. ; Compute future appointments
  1. D KAPPT^WVUTL9(WVDFN) ;kill off old computed appts.
  1. D GAPPT^WVUTL9(WVDFN) ;get future appts
  1. D SAPPT^WVUTL9(WVDFN) ;set appts in File 790
  1. D KILLUG^WVUTL9 ;kill off Utility global off future appts
  1. D KADD^WVUTL9(WVDFN) ;kill off old computed address
  1. D GADD^WVUTL9(WVDFN) ;get current complete address
  1. D SADD^WVUTL9(WVDFN) ;set complete address in File 790
  1. D KVAR^WVUTL9 ;clean-up VADPT variables used
  1. ; print the letter
  1. D EN2^DIWF
  1. ; don't stuff "date printed" if it already has a "date printed".
  1. I $P(^WV(790.4,WVDA,0),U,10)]"" D KILLXREF^WVLETPR(WVDA,WVKDT) Q
  1. ;
  1. ; next lines kill "aprt" xref and set "date printed"=today.
  1. ; ("aprt" xref indicate a notification is queued to be printed.)
  1. D KILLXREF^WVLETPR(WVDA,WVKDT)
  1. D DIE^WVFMAN(790.4,".1////"_DT,WVDA)
  1. Q
  1. LETTER(RESULT,WVIEN) ; Returns the letter text for the purpose of
  1. ; notification
  1. ; Input: RESULT - array name to return data in [required]
  1. ; WVIEN - FILE 790.404 IEN [required]
  1. ;
  1. ; Output: RESULT(0)=First line of letter text <OR>
  1. ; -1^error message
  1. ; RESULT(n)= remaining lines of letter text
  1. I '$G(WVIEN) S RESULT(0)="-1^Purpose IEN not greater than 0" Q
  1. I '$D(^WV(790.404,WVIEN,0)) D Q
  1. .S RESULT(0)="-1^No such purpose of notification"
  1. .Q
  1. I '$O(^WV(790.404,WVIEN,1,0)) D Q
  1. .S RESULT(0)="-1^No letter defined for this purpose"
  1. .Q
  1. N WVCNT,WVLOOP
  1. S RESULT(0)="",(WVCNT,WVLOOP)=0
  1. F S WVLOOP=$O(^WV(790.404,WVIEN,1,WVLOOP)) Q:'WVLOOP D
  1. .S WVCNT=WVCNT+1
  1. .S RESULT(WVCNT)=$G(^WV(790.404,WVIEN,1,WVLOOP,0))
  1. .Q
  1. Q
  1. ;
  1. GETDXIEN(WVX) ; Function returns FILE 790.31 IEN
  1. ; Input: WVX="A" for Abnormal
  1. ; "N" for No Evidence of Malignancy
  1. ; "U" for Unsatisfactory for Dx
  1. ; Output: IEN of corresponding FILE 790.31 entry
  1. S WVX=$G(WVX,"")
  1. I WVX="" Q ""
  1. S WVX=$$UP^XLFSTR(WVX)
  1. I WVX="A" Q $O(^WV(790.31,"B","Abnormal",0))
  1. I WVX="N" Q $O(^WV(790.31,"B","No Evidence of Malignancy",0))
  1. I WVX="U" Q $O(^WV(790.31,"B","Unsatisfactory for Dx",0))
  1. Q ""
  1. ;
  1. GETYPIEN(WVX) ; Function returns FILE 790.403 IEN
  1. ; Input: WVX="P" for CONTACT PHN
  1. ; WVX="I" for CONVERSATION WITH PATIENT
  1. ; WVX="L" for LETTER, FIRST
  1. ; Output: IEN of corresponding FILE 790.403 entry
  1. S WVX=$G(WVX,"")
  1. I WVX="" Q ""
  1. S WVX=$$UP^XLFSTR(WVX)
  1. I WVX="P" Q $O(^WV(790.403,"B","CONTACT PHN",0))
  1. I WVX="I" Q $O(^WV(790.403,"B","CONVERSATION WITH PATIENT",0))
  1. I WVX="L" Q $O(^WV(790.403,"B","LETTER, FIRST",0))
  1. Q ""
  1. ;
  1. GETOIEN(WVX) ; Function returns FILE 790.405 IEN
  1. ; Input: WVX = .01 value of FILE 790.405 entry (Outcome)
  1. ; Output: IEN of that entry
  1. S WVX=$G(WVX,"")
  1. I WVX="" Q ""
  1. Q $O(^WV(790.405,"B",WVX,0))
  1. ;