- 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 Feb 19, 2025@00:14:08 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 ;