- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBXSC75.m
r613 r623 1 IBXSC75 ; ; 01/03/091 IBXSC75 ; ;12/27/07 2 2 D DE G BEGIN 3 DE S DIE="^DGCR(399, D0,""RC"",",DIC=DIE,DP=399.042,DL=2,DIEL=1,DU="" K DG,DE,DB Q:$O(^DGCR(399,D0,"RC",DA,""))=""4 I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,1 ) S:%]"" DE(1)=% S %=$P(%Z,U,2) S:%]"" DE(2)=% S %=$P(%Z,U,3) S:%]"" DE(3)=% S %=$P(%Z,U,4) S:%]"" DE(4)=% S %=$P(%Z,U,5) S:%]"" DE(5)=% S %=$P(%Z,U,6) S:%]"" DE(7)=% S %=$P(%Z,U,7) S:%]"" DE(9)=%5 I S %=$P(%Z,U,9) S:%]"" DE(6)=% S %=$P(%Z,U,10) S:%]"" DE(12)=% S %=$P(%Z,U,12) S:%]"" DE(13)=% S %=$P(%Z,U,15) S:%]"" DE(18)=%3 DE S DIE="^DGCR(399,",DIC=DIE,DP=399,DL=1,DIEL=0,DU="" K DG,DE,DB Q:$O(^DGCR(399,DA,""))="" 4 I $D(^(0)) S %Z=^(0) S %=$P(%Z,U,19) S:%]"" DE(1)=%,DE(5)=% 5 I $D(^("U")) S %Z=^("U") S %=$P(%Z,U,1) S:%]"" DE(19)=% S %=$P(%Z,U,2) S:%]"" DE(20)=% S %=$P(%Z,U,3) S:%]"" DE(16)=% S %=$P(%Z,U,5) S:%]"" DE(11)=% S %=$P(%Z,U,6) S:%]"" DE(14)=% S %=$P(%Z,U,7) S:%]"" DE(13)=% 6 6 K %Z Q 7 7 ; … … 50 50 NKEY W:'$D(ZTQUEUED) "?? Required key field" S X="?BAD" G QS 51 51 KEYCHK() Q:$G(DE(DW,"KEY"))="" 1 Q @DE(DW,"KEY") 52 BEGIN S DNM="IBXSC75",DQ=1 +D G B53 1 S DW="0;1",DV="MR*P399.2'",DU="",DLB="REVENUE CODE",DIFLD=.0154 S DE(DW)="C1^IBXSC75" ,DE(DW,"INDEX")=155 S DU=" DGCR(399.2,"56 G RE :'D S DQ=2 G 252 BEGIN S DNM="IBXSC75",DQ=1 53 1 D:$D(DG)>9 F^DIE17,DE S DQ=1,DW="0;19",DV="R*P353'",DU="",DLB="FORM TYPE",DIFLD=.19 54 S DE(DW)="C1^IBXSC75" 55 S DU="IBE(353," 56 G RE 57 57 C1 G C1S:$D(DE(1))[0 K DB 58 58 S X=DE(1),DIC=DIE 59 K ^DGCR(399,DA(1),"RC","B",$E(X,1,30),DA) 60 S X=DE(1),DIC=DIE 61 I $P(^DGCR(399,DA(1),"RC",DA,0),U,5) K ^DGCR(399,DA(1),"RC","ABS",$P(^DGCR(399,DA(1),"RC",DA,0),U,5),$E(X,1,30),DA) 59 ; 60 S X=DE(1),DIC=DIE 61 S DGRVRCAL=2 62 S X=DE(1),DIC=DIE 63 D ALLID^IBCEP3(DA,.19,2) 64 S X=DE(1),DIC=DIE 65 ; 66 S X=DE(1),DIC=DIE 67 D ATTREND^IBCU1(DA,"","") 62 68 C1S S X="" G:DG(DQ)=X C1F1 K DB 63 69 S X=DG(DQ),DIC=DIE 64 S ^DGCR(399,DA(1),"RC","B",$E(X,1,30),DA)="" 65 S X=DG(DQ),DIC=DIE 66 I $P(^DGCR(399,DA(1),"RC",DA,0),U,5) S ^DGCR(399,DA(1),"RC","ABS",$P(^DGCR(399,DA(1),"RC",DA,0),U,5),$E(X,1,30),DA)="" 67 C1F1 N X,X1,X2 S DIXR=53 D C1X1(U) K X2 M X2=X D C1X1("O") K X1 M X1=X 68 I $G(X(1))]"" D 69 . I X(2)'=""&'$D(^TMP("IBCRRX",$J)) D DELPR^IBCU1(DA(1),X(2)) 70 G C1F2 71 C1X1(DION) K X 72 S X(1)=$G(@DIEZTMP@("V",399.042,DIIENS,.01,DION),$P($G(^DGCR(399,DA(1),"RC",DA,0)),U,1)) 73 S X(2)=$G(@DIEZTMP@("V",399.042,DIIENS,.15,DION),$P($G(^DGCR(399,DA(1),"RC",DA,0)),U,15)) 74 S X=$G(X(1)) 75 Q 76 C1F2 Q 77 X1 S DIC("S")="I +$P(^(0),U,3)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X 78 Q 79 ; 80 2 D:$D(DG)>9 F^DIE17,DE S DQ=2,DW="0;2",DV="RNJ8,2",DU="",DLB="CHARGES",DIFLD=.02 81 S DE(DW)="C2^IBXSC75" 82 G RE 83 C2 G C2S:$D(DE(2))[0 K DB 84 S X=DE(2),DIC=DIE 85 D 22^IBCU2 86 C2S S X="" G:DG(DQ)=X C2F1 K DB 87 S X=DG(DQ),DIC=DIE 88 D 21^IBCU2 89 C2F1 Q 90 X2 S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>99999)!(X<0) X 91 Q 92 ; 93 3 D:$D(DG)>9 F^DIE17,DE S DQ=3,DW="0;3",DV="RNJ6,0X",DU="",DLB="UNITS OF SERVICE",DIFLD=.03 94 S DE(DW)="C3^IBXSC75" 95 G RE 96 C3 G C3S:$D(DE(3))[0 K DB 97 S X=DE(3),DIC=DIE 98 D 32^IBCU2 99 C3S S X="" G:DG(DQ)=X C3F1 K DB 100 S X=DG(DQ),DIC=DIE 101 D 31^IBCU2 102 C3F1 Q 103 X3 K:X'?1.N X I $D(X) S:X=0 X=1 104 Q 105 ; 106 4 D:$D(DG)>9 F^DIE17,DE S DQ=4,DW="0;4",DV="RNJ9,2XI",DU="",DLB="TOTAL",DIFLD=.04 107 S DE(DW)="C4^IBXSC75" 108 G RE 109 C4 G C4S:$D(DE(4))[0 K DB 110 S X=DE(4),DIC=DIE 111 S DGXRF=2 D TC^IBCU2 K DGXRF 112 C4S S X="" G:DG(DQ)=X C4F1 K DB 113 S X=DG(DQ),DIC=DIE 114 S DGXRF=1 D TC^IBCU2 K DGXRF 115 C4F1 Q 116 X4 K:X?1.10N.1".".2N X 117 Q 118 ; 119 5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW="0;5",DV="R*P399.1'",DU="",DLB="BEDSECTION",DIFLD=.05 70 X ^DD(399,.19,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X=DIV S X=5 S DIH=$G(^DGCR(399,DIV(0),0)),DIV=X S $P(^(0),U,9)=DIV,DIH=399,DIG=.09 D ^DICR 71 S X=DG(DQ),DIC=DIE 72 S DGRVRCAL=1 73 S X=DG(DQ),DIC=DIE 74 D ALLID^IBCEP3(DA,.19,1) 75 S X=DG(DQ),DIC=DIE 76 D BILLPNS^IBCU(DA) 77 S X=DG(DQ),DIC=DIE 78 D ATTREND^IBCU1(DA,"","") 79 C1F1 Q 80 X1 S DIC("S")="N Z S Z=$G(^IBE(353,Y,2)) I $P(Z,U,2)=""P"",$P(Z,U,4)" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X 81 Q 82 ; 83 2 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=2 D X2 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 84 X2 S DIPA("FT")=$P($G(^DGCR(399,DA,0)),U,19) 85 Q 86 3 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=3 D X3 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 87 X3 I $P($G(^IBE(353,+DIPA("FT"),2)),U,2)="P",$P($G(^(2)),U,4) S DIPA("FT1")=DIPA("FT") D CKFT^IBCIUT1(IBIFN) S Y="@715" 88 Q 89 4 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=4 D X4 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 90 X4 W !,*7,"Must be a printable national form type" 91 Q 92 5 D:$D(DG)>9 F^DIE17,DE S DQ=5,DW="0;19",DV="R*P353'",DU="",DLB="FORM TYPE",DIFLD=.19 120 93 S DE(DW)="C5^IBXSC75" 121 S DU="DGCR(399.1," 122 G RE 94 S DU="IBE(353," 95 S X=$G(DIPA("FT1")) 96 S Y=X 97 S X=Y,DB(DQ)=1 G:X="" N^DIE17:DV,A I $D(DE(DQ)),DV["I"!(DV["#") D E^DIE0 G A:'$D(X) 98 G RD 123 99 C5 G C5S:$D(DE(5))[0 K DB 124 100 S X=DE(5),DIC=DIE 125 K ^DGCR(399,DA(1),"RC","ABS",$E(X,1,30),+^DGCR(399,DA(1),"RC",DA,0),DA) 101 ; 102 S X=DE(5),DIC=DIE 103 S DGRVRCAL=2 104 S X=DE(5),DIC=DIE 105 D ALLID^IBCEP3(DA,.19,2) 106 S X=DE(5),DIC=DIE 107 ; 108 S X=DE(5),DIC=DIE 109 D ATTREND^IBCU1(DA,"","") 126 110 C5S S X="" G:DG(DQ)=X C5F1 K DB 127 111 S X=DG(DQ),DIC=DIE 128 S ^DGCR(399,DA(1),"RC","ABS",$E(X,1,30),+^DGCR(399,DA(1),"RC",DA,0),DA)="" 112 X ^DD(399,.19,1,1,1.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,0)):^(0),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X=DIV S X=5 S DIH=$G(^DGCR(399,DIV(0),0)),DIV=X S $P(^(0),U,9)=DIV,DIH=399,DIG=.09 D ^DICR 113 S X=DG(DQ),DIC=DIE 114 S DGRVRCAL=1 115 S X=DG(DQ),DIC=DIE 116 D ALLID^IBCEP3(DA,.19,1) 117 S X=DG(DQ),DIC=DIE 118 D BILLPNS^IBCU(DA) 119 S X=DG(DQ),DIC=DIE 120 D ATTREND^IBCU1(DA,"","") 129 121 C5F1 Q 130 X5 S DIC("S")="I $P(^(0),U,5)" D ^DIC K DIC S DIC=DIE,X=+Y K:Y<0 X 131 Q 132 ; 133 6 D:$D(DG)>9 F^DIE17,DE S DQ=6,DW="0;9",DV="NJ8,2",DU="",DLB="NON-COVERED CHARGE",DIFLD=.09 134 G RE 135 X6 S:X["$" X=$P(X,"$",2) K:X'?.N.1".".2N!(X>99999)!(X<0)!(X?.E1"."3.N) X 136 Q 137 ; 138 7 S DW="0;6",DV="*P81'",DU="",DLB="PROCEDURE",DIFLD=.06 139 S DE(DW)="C7^IBXSC75" 140 S DU="ICPT(" 141 G RE 142 C7 G C7S:$D(DE(7))[0 K DB 143 S X=DE(7),DIC=DIE 144 K ^DGCR(399,"ASC1",$E(X,1,30),DA(1),DA) 145 S X=DE(7),DIC=DIE 146 K ^DGCR(399,"ASC2",DA(1),$E(X,1,30),DA) 147 C7S S X="" G:DG(DQ)=X C7F1 K DB 148 S X=DG(DQ),DIC=DIE 149 I $$RC^IBEFUNC1(DA(1),DA) S ^DGCR(399,"ASC1",$E(X,1,30),DA(1),DA)="" 150 S X=DG(DQ),DIC=DIE 151 I $$RC^IBEFUNC1(DA(1),DA) S ^DGCR(399,"ASC2",DA(1),$E(X,1,30),DA)="" 152 C7F1 Q 153 X7 S ICPTVDT=$$BDATE^IBACSV($G(DA(1))),DIC("S")="I $$CPTACT^IBACSV(+Y,ICPTVDT)",DIC("W")="D EN^DDIOL("" ""_$P($$CPT^IBACSV(+Y,ICPTVDT),U,2),,""?0"")" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X 154 Q 155 ; 122 X5 S DIC("S")="N Z S Z=$G(^IBE(353,Y,2)) I $P(Z,U,2)=""P"",$P(Z,U,4)" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X 123 Q 124 ; 125 6 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=6 D X6 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 126 X6 S Y="@714" 127 Q 128 7 S DQ=8 ;@715 156 129 8 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=8 D X8 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 157 X8 I '$P(^DGCR(399,DA(1),"RC",DA,0),U,6) S Y="@758" 158 Q 159 9 D:$D(DG)>9 F^DIE17,DE S DQ=9,DW="0;7",DV="P40.8'X",DU="",DLB="DIVISION",DIFLD=.07 160 S DE(DW)="C9^IBXSC75" 161 S DU="DG(40.8," 162 S X=$$DEFDIV^IBCU7(DA(1)) 163 S Y=X 164 G Y 165 C9 G C9S:$D(DE(9))[0 K DB 166 S X=DE(9),DIC=DIE 167 K ^DGCR(399,"ASC1",+$P(^DGCR(399,DA(1),"RC",DA,0),U,6),DA(1),DA) 168 S X=DE(9),DIC=DIE 169 K ^DGCR(399,"ASC2",DA(1),+$P(^DGCR(399,DA(1),"RC",DA,0),U,6),DA) 170 C9S S X="" G:DG(DQ)=X C9F1 K DB 171 S X=DG(DQ),DIC=DIE 172 I $$RC^IBEFUNC1(DA(1),DA) S ^DGCR(399,"ASC1",$P(^DGCR(399,DA(1),"RC",DA,0),U,6),DA(1),DA)="" 173 S X=DG(DQ),DIC=DIE 174 I $$RC^IBEFUNC1(DA(1),DA) S ^DGCR(399,"ASC2",DA(1),$P(^DGCR(399,DA(1),"RC",DA,0),U,6),DA)="" 175 C9F1 Q 176 X9 Q 177 10 S DQ=11 ;@758 178 11 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=11 D X11 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 179 X11 I +$P(^DGCR(399,DA(1),"RC",DA,0),U,8) W !," AUTO ADDED CHARGE - NO CHANGE TO TYPE/COMPONENT" S Y="@759" 180 Q 181 12 D:$D(DG)>9 F^DIE17,DE S DQ=12,DW="0;10",DV="S",DU="",DLB="TYPE",DIFLD=.1 182 S DE(DW)="C12^IBXSC75" 183 S DU="1:INPT BS;2:OPT VST DT;3:RX;4:CPT;5:PROS;6:DRG;9:UNASSOCIATED;" 184 G RE 185 C12 G C12S:$D(DE(12))[0 K DB 186 S X=DE(12),DIC=DIE 187 K DIV S DIV=X,D0=DA(1),DIV(0)=D0,D1=DA,DIV(1)=D1 S Y(1)=$S($D(^DGCR(399,D0,"RC",D1,0)):^(0),1:"") S X=$P(Y(1),U,11),X=X S DIU=X K Y S X="" X ^DD(399.042,.1,1,1,2.4) 188 S X=DE(12),DIC=DIE 189 X ^DD(399.042,.1,1,2,2.3) I X S X=DIV S Y(1)=$S($D(^DGCR(399,D0,"RC",D1,0)):^(0),1:"") S X=$P(Y(1),U,15),X=X S DIU=X K Y S X="" S DIH=$G(^DGCR(399,DIV(0),"RC",DIV(1),0)),DIV=X S $P(^(0),U,15)=DIV,DIH=399.042,DIG=.15 D ^DICR 190 C12S S X="" G:DG(DQ)=X C12F1 K DB 191 S X=DG(DQ),DIC=DIE 192 ; 193 S X=DG(DQ),DIC=DIE 194 ; 195 C12F1 Q 196 X12 Q 197 13 D:$D(DG)>9 F^DIE17,DE S DQ=13,DW="0;12",DV="S",DU="",DLB="COMPONENT",DIFLD=.12 198 S DU="1:INSTITUTIONAL;2:PROFESSIONAL;" 199 G RE 200 X13 Q 201 14 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=14 D X14 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 202 X14 I $S($P($G(^DGCR(399,DA(1),"RC",DA,0)),U,10)=3:0,1:$P($G(^(0)),U,10)'=4)!$P($G(^(0)),U,8) S Y="@759" 203 Q 130 X8 D FTPRV^IBCEU5(DA) 131 Q 132 9 S DQ=10 ;@72 133 10 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=10 D X10 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 134 X10 S:IBDR20'["72" Y="@73" 135 Q 136 11 D:$D(DG)>9 F^DIE17,DE S DQ=11,DW="U;5",DV="RFOX",DU="",DLB="IS THIS A SENSITIVE RECORD?",DIFLD=155 137 S DQ(11,2)="S Y(0)=Y S Y=$S(Y:""YES"",Y=0:""NO"",1:"""")" 138 G RE 139 X11 I $D(X) D YN^IBCU 140 I $D(X),X'?.ANP K X 141 Q 142 ; 143 12 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=12 D X12 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 144 X12 S:X=0 Y=156 145 Q 146 13 S DW="U;7",DV="FOX",DU="",DLB="R.O.I. FORM(S) COMPLETED?",DIFLD=157 147 S DQ(13,2)="S Y(0)=Y S Y=$S(Y:""YES"",Y=0:""NO"",1:"""")" 148 G RE 149 X13 I $D(X) D YN^IBCU 150 I $D(X),X'?.ANP K X 151 Q 152 ; 153 14 S DW="U;6",DV="RFOX",DU="",DLB="ASSIGNMENT OF BENEFITS",DIFLD=156 154 S DQ(14,2)="S Y(0)=Y S Y=$S(Y="""":"""",""Yy1""[Y:""YES"",""Nn0""[Y:""NO"",1:"""")" 155 G RE 156 X14 I $D(X) D YN^IBCU I $D(X) X:X=0 ^DD(399,156,9.3) K IBRATY 157 I $D(X),X'?.ANP K X 158 Q 159 ; 204 160 15 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=15 D X15 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 205 X15 I $P($G(^DGCR(399,DA(1),"RC",DA,0)),U,10)=4 S Y="@7581" 206 Q 207 16 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=16 D X16 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 208 X16 S DGRVRCAL=1 209 Q 210 17 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=17 D X17 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 211 X17 D LINKRX^IBCEU5(DA(1),DA) 212 Q 213 18 S DW="0;15",DV="FXO",DU="",DLB="RX PROCEDURE",DIFLD=.15 214 S DQ(18,2)="S Y(0)=Y S Y=Y_"" - ""_$P($$PRCNM^IBCSCH1($P($G(^DGCR(399,D0,""CP"",+Y,0)),U)),U)" 215 S DE(DW)="C18^IBXSC75",DE(DW,"INDEX")=1 216 G RE 217 C18 G C18S:$D(DE(18))[0 K DB 218 S X=DE(18),DIC=DIE 219 K ^DGCR(399,DA(1),"RC","ACP",$E(X,1,30),DA) 220 C18S S X="" G:DG(DQ)=X C18F1 K DB 221 S X=DG(DQ),DIC=DIE 222 S ^DGCR(399,DA(1),"RC","ACP",$E(X,1,30),DA)="" 223 C18F1 N X,X1,X2 S DIXR=53 D C18X1(U) K X2 M X2=X D C18X1("O") K X1 M X1=X 224 I $G(X(1))]"" D 225 . I X(2)'=""&'$D(^TMP("IBCRRX",$J)) D DELPR^IBCU1(DA(1),X(2)) 226 G C18F2 227 C18X1(DION) K X 228 S X(1)=$G(@DIEZTMP@("V",399.042,DIIENS,.01,DION),$P($G(^DGCR(399,DA(1),"RC",DA,0)),U,1)) 229 S X(2)=$G(@DIEZTMP@("V",399.042,DIIENS,.15,DION),$P($G(^DGCR(399,DA(1),"RC",DA,0)),U,15)) 230 S X=$G(X(1)) 231 Q 232 C18F2 Q 233 X18 S X=$$RXPRLOOK^IBCEU4(X) K:'X X 234 I $D(X),X'?.ANP K X 235 Q 236 ; 237 19 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=19 D X19 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 238 X19 S Y="@759" 239 Q 240 20 S DQ=21 ;@7581 241 21 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=21 D X21 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 242 X21 D LINKCPT^IBCEU5(DA(1),DA) 243 Q 244 22 S DQ=23 ;@759 245 23 G 1^DIE17 161 X15 S:'$D(IBOX) Y="@73" 162 Q 163 16 S DW="U;3",DV="RFOX",DU="",DLB="POWER OF ATTORNEY COMPLETED?",DIFLD=153 164 S DQ(16,2)="S Y(0)=Y S Y=$S(Y:""YES"",Y=0:""NO"",1:"""")" 165 G RE 166 X16 I $D(X) D YN^IBCU 167 I $D(X),X'?.ANP K X 168 Q 169 ; 170 17 S DQ=18 ;@73 171 18 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=18 D X18 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 172 X18 S:IBDR20'["73" Y="@75" 173 Q 174 19 S DW="U;1",DV="RDX",DU="",DLB="STATEMENT COVERS FROM",DIFLD=151 175 S DE(DW)="C19^IBXSC75" 176 G RE 177 C19 G C19S:$D(DE(19))[0 K DB 178 S X=DE(19),DIC=DIE 179 ; 180 S X=DE(19),DIC=DIE 181 S DGRVRCAL=2 182 S X=DE(19),DIC=DIE 183 ; 184 S X=DE(19),DIC=DIE 185 K:$P(^DGCR(399,DA,0),"^",2) ^DGCR(399,"APDS",$P(^(0),U,2),-X,DA) 186 C19S S X="" G:DG(DQ)=X C19F1 K DB 187 D ^IBXSC76 188 C19F1 Q 189 X19 S %DT="ETP" D ^%DT S X=Y K:Y<1 X I $D(X) D DDAT^IBCU4 K IB00 190 Q 191 ; 192 20 D:$D(DG)>9 F^DIE17,DE S DQ=20,DW="U;2",DV="RDX",DU="",DLB="STATEMENT COVERS TO",DIFLD=152 193 S DE(DW)="C20^IBXSC75" 194 G RE 195 C20 G C20S:$D(DE(20))[0 K DB 196 S X=DE(20),DIC=DIE 197 ; 198 S X=DE(20),DIC=DIE 199 S DGRVRCAL=2 200 C20S S X="" G:DG(DQ)=X C20F1 K DB 201 D ^IBXSC77 202 C20F1 Q 203 X20 S %DT="ETP" D ^%DT S X=Y K:Y<1 X I $D(X) D DDAT1^IBCU4 K IB00 204 Q 205 ; 206 21 S DQ=22 ;@75 207 22 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=22 D X22 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 208 X22 S:IBDR20'["75" Y="@76" 209 Q 210 23 D:$D(DG)>9 F^DIE17,DE S Y=U,DQ=23 D X23 D:$D(DIEFIRE)#2 FIREREC^DIE17 G A:$D(Y)[0,A:Y=U S X=Y,DIC(0)="F",DW=DQ G OUT^DIE17 211 X23 D RCD^IBCU1 212 Q 213 24 D:$D(DG)>9 F^DIE17 G ^IBXSC78
Note:
See TracChangeset
for help on using the changeset viewer.
