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