Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDLT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDLT.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDLT.m
r613 r623 1 SDLT ;ALB/LDB - CANCELLATION LETTERS ; 14 Feb 2003 2 ;;5.3;Scheduling;**185,213,281,330,398,523**;Aug 13, 1993;Build 6 3 ; 4 ;************************************************************************** 5 ; MODIFICATIONS 6 ; 7 ; DATE PATCH DEVELOPER DESCRIPTION OF CHANGES 8 ; -------- ---------- --------- ---------------------------------------- 9 ; 02/14/03 SD*5.3*281 SAUNDERS Print letters to confidential address if 10 ; requested 11 ; 12/2/03 SD*5.3*330 LUNDEN Remove form feed from PRT+0 12 ; 13 ;************************************************************************** 14 ; 15 ;WRITE GREETING AND OPENING TEXT OF LETTER 16 PRT S DFN=$P(A,U,1) ;SD*523 17 I $D(SDNOSH) I $D(^DPT(DFN,.1)) S POP=1 Q:POP ;SD/523 18 S Y=DT D DTS^SDUTL 19 I +$G(SDFIRST)=0 W @IOF ;SD*5.3*330 Form feed only after letter #1 20 K SDFIRST 21 ;S SDFIRST=0 22 W !,?65,Y,!,?65,$$LAST4(A),!!!! 23 I 'SDFORM W !!!!! D ADDR W !!!! 24 W1 W !,"Dear ",$S($P(^DPT(+A,0),"^",2)="M":"Mr. ",1:"Ms. ") 25 N DPTNAME 26 S DPTNAME("FILE")=2,DPTNAME("FIELD")=".01",DPTNAME("IENS")=(+A)_"," 27 S X=$$NAMEFMT^XLFNAME(.DPTNAME,"G","M") W X,"," 28 W !! K ^UTILITY($J,"W"),DIWF,DIWR,DIWF S DIWL=1,DIWF="C80WN" F Z0=0:0 S Z0=$O(^VA(407.5,SDLET,1,Z0)) Q:Z0'>0 S X=^(Z0,0) D ^DIWP 29 D ^DIWW K ^UTILITY($J,"W") Q 30 WRAPP ;WRITE APPOINTMENT INFORMATION 31 S:$D(SC)&'$D(SDC) SDC=SC S SDCL=$P(^SC(+SDC,0),"^",1),SDCL=SDCL_" Clinic" D FORM 32 S SDX1=$S($D(SDX):SDX,1:X) S:$D(SDS) S=SDS F B=3,4,5 I $P(S,"^",B)]"" S SDCL=$S(B=3:"LAB",B=4:"XRAY",1:"EKG"),SDX=$P(S,"^",B) D FORM 33 S (SDX,X)=SDX1 Q 34 FORM S:$D(SDX) X=SDX S SDHX=X D DW^%DTC S DOW=X,X=SDHX X ^DD("FUNC",2,1) S SDT0=X,SDDAT=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$E(SDHX,4,5))_" "_+$E(SDHX,6,7)_", "_(1700+$E(SDHX,1,3)) W !?4,DOW,?14,$J(SDDAT,12) 35 W ?27,$J(SDT0,8)," ",SDCL I $D(SDLT)&($Y>(IOSL-8)) W @IOF 36 Q 37 REST ;WRITE THE REMAINDER OF LETTER 38 I SDLET W !?12 K ^UTILITY($J,"W"),DIWL,DIWR,DIWF S DIWL=1,DIWF="C80WN" F Z5=0:0 S Z5=$O(^VA(407.5,SDLET,2,Z5)) Q:Z5'>0 S X=^(Z5,0) D ^DIWP 39 D ^DIWW K ^UTILITY($J,"W") Q:'SDFORM 40 F I=$Y:1:IOSL-12 W ! 41 D ADDR Q 42 ADDR K VAHOW S DFN=+A W !?12,$$FML^DGNFUNC(DFN) S VAHOW=2 43 I $D(^DG(43,1,"BT")),'$P(^("BT"),"^",3) S VAPA("P")="" 44 S X1=DT,X2=5 D C^%DTC I '$D(VAPA("P")) S (VATEST("ADD",9),VATEST("ADD",10))=X 45 D ADD^VADPT D 46 .;CHANGE STATE TO ABBR. 47 .N SDIENS,X 48 .I $D(^UTILITY("VAPA",$J,5)) S SDIENS=+^UTILITY("VAPA",$J,5)_",",X=$$GET1^DIQ(5,SDIENS,1),$P(^UTILITY("VAPA",$J,5),U,2)=X 49 .K SDIENS Q 50 N SDCCACT1,SDCCACT2 51 S SDCCACT1=^UTILITY("VAPA",$J,12),SDCCACT2=$P($G(^UTILITY("VAPA",$J,22,2)),"^",3) 52 ;if confidential address is not active for scheduling/appointment letters, print to regular address 53 I ($G(SDCCACT1)=0)!($G(SDCCACT2)'="Y") D 54 .F LL=1:1:4 W:^UTILITY("VAPA",$J,LL)]"" !,?12,^UTILITY("VAPA",$J,LL) 55 .W:^UTILITY("VAPA",$J,4)']"" ! I ^UTILITY("VAPA",$J,5)]"" W ", ",$P(^UTILITY("VAPA",$J,5),"^",2) 56 .I ^UTILITY("VAPA",$J,11)]"" W " ",$P(^UTILITY("VAPA",$J,11),U,2) 57 ;if confidential address is active for scheduling/appointment letters, print to confidential address 58 I $G(SDCCACT1)=1,$G(SDCCACT2)="Y" D 59 .F LL=13:1:16 W:^UTILITY("VAPA",$J,LL)]"" !,?12,^UTILITY("VAPA",$J,LL) 60 .W:^UTILITY("VAPA",$J,16)']"" ! I ^UTILITY("VAPA",$J,17)]"" W ", ",$P(^UTILITY("VAPA",$J,17),"^",2) 61 .I ^UTILITY("VAPA",$J,18)]"" W " ",$P(^UTILITY("VAPA",$J,18),U,2) 62 W ! D KVAR^VADPT Q 63 ; 64 ; 65 LAST4(DFN) ;Return patient "last four" 66 N SDX 67 S SDX=$G(^DPT(+DFN,0)) 68 Q $E(SDX)_$E($P(SDX,U,9),6,9) 69 ; 70 BADADD ;Print patients with a Bad Address Indicator 71 I '$D(^TMP($J,"BADADD")) Q 72 N SDHDR,SDHDR1 73 W @IOF,$TR($J("",IOM)," ","*") 74 S SDHDR="BAD ADDRESS INDICATOR LIST" W !,?(IOM-$L(SDHDR)/2),SDHDR,! 75 S SDHDR1="** THE LETTER FOR THESE PATIENT(S) DID NOT PRINT DUE TO A BAD ADDRESS INDICATOR." 76 W !,"Last 4",!,"of SSN",?10,"Patient Name",! 77 W $TR($J("",IOM)," ","*") 78 N SDNAM,SDDFN 79 S SDNAM="" F S SDNAM=$O(^TMP($J,"BADADD",SDNAM)) Q:SDNAM="" D 80 . S SDDFN=0 F S SDDFN=$O(^TMP($J,"BADADD",SDNAM,SDDFN)) Q:'SDDFN D 81 . . W !,$$LAST4(SDDFN),?10,SDNAM 82 W !!,SDHDR1 83 Q 1 SDLT ;ALB/LDB - CANCELLATION LETTERS ; 14 Feb 2003 2 ;;5.3;Scheduling;**185,213,281,330,398**;Aug 13, 1993 3 ; 4 ;************************************************************************** 5 ; MODIFICATIONS 6 ; 7 ; DATE PATCH DEVELOPER DESCRIPTION OF CHANGES 8 ; -------- ---------- --------- ---------------------------------------- 9 ; 02/14/03 SD*5.3*281 SAUNDERS Print letters to confidential address if 10 ; requested 11 ; 12/2/03 SD*5.3*330 LUNDEN Remove form feed from PRT+0 12 ; 13 ;************************************************************************** 14 ; 15 ;WRITE GREETING AND OPENING TEXT OF LETTER 16 PRT S Y=DT D DTS^SDUTL 17 I +$G(SDFIRST)=0 W @IOF ;SD*5.3*330 Form feed only after letter #1 18 K SDFIRST 19 ;S SDFIRST=0 20 W !,?65,Y,!,?65,$$LAST4(A),!!!! 21 I 'SDFORM W !!!!! D ADDR W !!!! 22 W1 W !,"Dear ",$S($P(^DPT(+A,0),"^",2)="M":"Mr. ",1:"Ms. ") 23 N DPTNAME 24 S DPTNAME("FILE")=2,DPTNAME("FIELD")=".01",DPTNAME("IENS")=(+A)_"," 25 S X=$$NAMEFMT^XLFNAME(.DPTNAME,"G","M") W X,"," 26 W !! K ^UTILITY($J,"W"),DIWF,DIWR,DIWF S DIWL=1,DIWF="C80WN" F Z0=0:0 S Z0=$O(^VA(407.5,SDLET,1,Z0)) Q:Z0'>0 S X=^(Z0,0) D ^DIWP 27 D ^DIWW K ^UTILITY($J,"W") Q 28 WRAPP ;WRITE APPOINTMENT INFORMATION 29 S:$D(SC)&'$D(SDC) SDC=SC S SDCL=$P(^SC(+SDC,0),"^",1),SDCL=SDCL_" Clinic" D FORM 30 S SDX1=$S($D(SDX):SDX,1:X) S:$D(SDS) S=SDS F B=3,4,5 I $P(S,"^",B)]"" S SDCL=$S(B=3:"LAB",B=4:"XRAY",1:"EKG"),SDX=$P(S,"^",B) D FORM 31 S (SDX,X)=SDX1 Q 32 FORM S:$D(SDX) X=SDX S SDHX=X D DW^%DTC S DOW=X,X=SDHX X ^DD("FUNC",2,1) S SDT0=X,SDDAT=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$E(SDHX,4,5))_" "_+$E(SDHX,6,7)_", "_(1700+$E(SDHX,1,3)) W !?4,DOW,?14,$J(SDDAT,12) 33 W ?27,$J(SDT0,8)," ",SDCL I $D(SDLT)&($Y>(IOSL-8)) W @IOF 34 Q 35 REST ;WRITE THE REMAINDER OF LETTER 36 I SDLET W !?12 K ^UTILITY($J,"W"),DIWL,DIWR,DIWF S DIWL=1,DIWF="C80WN" F Z5=0:0 S Z5=$O(^VA(407.5,SDLET,2,Z5)) Q:Z5'>0 S X=^(Z5,0) D ^DIWP 37 D ^DIWW K ^UTILITY($J,"W") Q:'SDFORM 38 F I=$Y:1:IOSL-12 W ! 39 D ADDR Q 40 ADDR K VAHOW S DFN=+A W !?12,$$FML^DGNFUNC(DFN) S VAHOW=2 41 I $D(^DG(43,1,"BT")),'$P(^("BT"),"^",3) S VAPA("P")="" 42 S X1=DT,X2=5 D C^%DTC I '$D(VAPA("P")) S (VATEST("ADD",9),VATEST("ADD",10))=X 43 D ADD^VADPT D 44 .;CHANGE STATE TO ABBR. 45 .N SDIENS,X 46 .I $D(^UTILITY("VAPA",$J,5)) S SDIENS=+^UTILITY("VAPA",$J,5)_",",X=$$GET1^DIQ(5,SDIENS,1),$P(^UTILITY("VAPA",$J,5),U,2)=X 47 .K SDIENS Q 48 N SDCCACT1,SDCCACT2 49 S SDCCACT1=^UTILITY("VAPA",$J,12),SDCCACT2=$P($G(^UTILITY("VAPA",$J,22,2)),"^",3) 50 ;if confidential address is not active for scheduling/appointment letters, print to regular address 51 I ($G(SDCCACT1)=0)!($G(SDCCACT2)'="Y") D 52 .F LL=1:1:4 W:^UTILITY("VAPA",$J,LL)]"" !,?12,^UTILITY("VAPA",$J,LL) 53 .W:^UTILITY("VAPA",$J,4)']"" ! I ^UTILITY("VAPA",$J,5)]"" W ", ",$P(^UTILITY("VAPA",$J,5),"^",2) 54 .I ^UTILITY("VAPA",$J,11)]"" W " ",$P(^UTILITY("VAPA",$J,11),U,2) 55 ;if confidential address is active for scheduling/appointment letters, print to confidential address 56 I $G(SDCCACT1)=1,$G(SDCCACT2)="Y" D 57 .F LL=13:1:16 W:^UTILITY("VAPA",$J,LL)]"" !,?12,^UTILITY("VAPA",$J,LL) 58 .W:^UTILITY("VAPA",$J,16)']"" ! I ^UTILITY("VAPA",$J,17)]"" W ", ",$P(^UTILITY("VAPA",$J,17),"^",2) 59 .I ^UTILITY("VAPA",$J,18)]"" W " ",$P(^UTILITY("VAPA",$J,18),U,2) 60 W ! D KVAR^VADPT Q 61 ; 62 ; 63 LAST4(DFN) ;Return patient "last four" 64 N SDX 65 S SDX=$G(^DPT(+DFN,0)) 66 Q $E(SDX)_$E($P(SDX,U,9),6,9) 67 ; 68 BADADD ;Print patients with a Bad Address Indicator 69 I '$D(^TMP($J,"BADADD")) Q 70 N SDHDR,SDHDR1 71 W @IOF,$TR($J("",IOM)," ","*") 72 S SDHDR="BAD ADDRESS INDICATOR LIST" W !,?(IOM-$L(SDHDR)/2),SDHDR,! 73 S SDHDR1="** THE LETTER FOR THESE PATIENT(S) DID NOT PRINT DUE TO A BAD ADDRESS INDICATOR." 74 W !,"Last 4",!,"of SSN",?10,"Patient Name",! 75 W $TR($J("",IOM)," ","*") 76 N SDNAM,SDDFN 77 S SDNAM="" F S SDNAM=$O(^TMP($J,"BADADD",SDNAM)) Q:SDNAM="" D 78 . S SDDFN=0 F S SDDFN=$O(^TMP($J,"BADADD",SDNAM,SDDFN)) Q:'SDDFN D 79 . . W !,$$LAST4(SDDFN),?10,SDNAM 80 W !!,SDHDR1 81 Q
Note:
See TracChangeset
for help on using the changeset viewer.
