Changeset 623 for WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCR.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/BENEFICIARY_TRAVEL-DGBT/DGBTCR.m
r613 r623 1 DGBTCR ;ALB/SCK - BENEFICIARY TRAVEL FORM 70-3542d VARIABLES; 2/7/88@08:00 ;6/11/93@09:30 2 ;;1.0;Beneficiary Travel;**7,14**;September 25, 2001;Build 7 3 ;Modification of AIVBTPRT / pmg / GRAND ISLAND ; 07 Jul 88 12:02 PM 4 START Q:'$D(DGBTDT) 5 S DGBTVAR(0)=$G(^DGBT(392,+DGBTDT,0)),DGBTACCT=$P($G(^DGBT(392.3,+$P(DGBTVAR(0),"^",6),0)),"^",5) 6 Q:DGBTACCT'>3 7 W !!,*7,"This needs to be printed at 132 columns" 8 S DGPGM="PRINT^DGBTCR",DGVAR="DGBTDT" 9 S %ZIS="PMQ" D ^%ZIS G QUIT:POP 10 I $D(IO("Q")) D QUE G QUIT 11 D PRINT 12 QUIT ; 13 D:'$D(ZTQUEUED) ^%ZISC 14 K DGPGM,DGVAR,VADAT,VADATE,I,X,X2,DGBTVAR,DGBTCC,DGBTDIV,DGBTDOB,DGBTINS,DGBTINS1,DGBTINS2,DGBTCNA,DGBTCSZ,DGBTCNU,DGBTTCTY,DGBTFCTY,DGBTDT,DGBTACCT,DFN,Y 15 K DGBTM6,DGBTM7,DGBTM8,DGBTM9,DGBTM10,DGBTM11,DGBTM12,DGBTM13,DGBTM14,DGBTM15,DGBTM16,DGBTM17,DGBTRATE,DGBTSCP,DGBTSSN,DGBTST 16 Q 17 PRINT ; 18 U IO D SET,PRINT^DGBTCR1,PRINT^DGBTCR2,KVAR^VADPT 19 Q 20 SET S DFN=$P(^DGBT(392,DGBTDT,0),"^",2) D 6^VADPT S (DGBTFCTY,DGBTTCTY)="" 21 NODES F I=0,"A","D","M","R","T" S DGBTVAR(I)=$S($D(^DGBT(392,DGBTDT,I)):^(I),1:"") 22 I $D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")) S DGBTRATE=^("BT"),DGBTM7=$S($P(DGBTVAR("A"),"^",3)=1:$P(DGBTRATE,"^",5),1:$P(DGBTRATE,"^",3)) 23 I $P(DGBTVAR("D"),"^",4)]"" S DGBTCNA=$P(DGBTVAR("D"),"^",4) D CITY I DGBTCSZ[DGBTCNA D 24 . S DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("D"),"^",5)>0:$P(^DIC(5,$P(DGBTVAR("D"),"^",5),0),U,2),1:"")_" " 25 . S Y=$P(DGBTVAR("D"),U,6),Y=$E(Y,1,5)_$S($E(Y,6,9)]"":"-"_$E(Y,6,9),1:""),DGBTCSZ=DGBTCSZ_Y,DGBTFCTY=DGBTCSZ 26 I $P(DGBTVAR("T"),"^",4)]"" S DGBTCNA=$P(DGBTVAR("T"),U,4) D CITY^DGBTCR S:DGBTCSZ[DGBTCNA DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("T"),"^",5)>0:$P(^DIC(5,$P(DGBTVAR("T"),"^",5),0),U,2),1:"")_" "_$P(DGBTVAR("T"),U,6) S DGBTTCTY=DGBTCSZ 27 DIV S DGBTDIV=$P(DGBTVAR(0),"^",11) I +DGBTDIV S DGBTDIV=$P(^DG(40.8,DGBTDIV,0),"^",7) S (DGBTCC,DGBTST)="" 28 I $D(^DIC(4,+DGBTDIV,0)) S DGBTINS=^(0),DGBTINS1=$S($D(^DIC(4,DGBTDIV,1)):^(1),1:""),DGBTINS2=$S(DGBTINS1]"":$P(DGBTINS1,"^",3)_",",1:"UNSPECIFIED")_" "_$S($D(^DIC(5,+$P(DGBTINS,U,2),0)):$P(^(0),U,2),1:"")_" "_$P(DGBTINS1,"^",4) 29 I VAPA(5)&(VAPA(7)) S DGBTCC=$S($D(^DIC(5,+VAPA(5),1,+VAPA(7),0)):$P(^(0),"^",3),1:""),DGBTST=$P(^DIC(5,+VAPA(5),0),"^",2) 30 ;S DGBTSSN=$P($P(VADM(2),"^",2),"-")_" "_$P($P(VADM(2),"^",2),"-",2)_" "_$P($P(VADM(2),"^",2),"-",3),DGBTDOB=$E(VADM(3),4,7)_$E(VADM(3),2,3) 31 D PID^VADPT6 S DGBTSSN=VA("PID"),DGBTDOB=$E(VADM(3),4,7)_($E(VADM(3),1,3)+1700) 32 S DGBTSCP=$S($L($P(VAEL(3),"^",2)<3):"0",1:"")_$P(VAEL(3),"^",2) 33 MILES S DGBTM6=$P(DGBTVAR("M"),"^")*$P(DGBTVAR("M"),"^",2) 34 N X3 35 S X2="2$",X=DGBTM6*DGBTM7 D COMMA^%DTC S DGBTM8=X 36 S X=$P(DGBTVAR("M"),"^",4) D COMMA^%DTC S DGBTM9=X 37 S X=$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM10=X 38 S X=DGBTM6*DGBTM7+$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM11=X 39 S X2="3$",X=DGBTM7 D COMMA^%DTC S DGBTM7=X 40 S X2="2$" ;Reset edit mask to 2 decimal positions for rest of report 41 S X=$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM12=X 42 S X=$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM13=X 43 S X=$P(DGBTVAR(0),"^",10) D COMMA^%DTC S DGBTM14=X 44 S X=$P(DGBTVAR(0),"^",9) D COMMA^%DTC S $P(DGBTM14,"^",2)=X 45 CERT S VADAT("W")=DGBTDT D ^VADATE S DGBTM15=VADATE("E") 46 S X=$S($P(^DG(43,1,"BT"),"^")'="":$P(^DG(43,1,"BT"),"^"),1:DUZ),DGBTM16=$P($P(^VA(200,X,0),",",2),"^")_" "_$P(^VA(200,X,0),",")_$S($P(^DG(43,1,"BT"),"^")'="":"",1:", DESIGNEE OF CERTIFYING OFFICIAL") K X 47 S DGBTM17=$P($P(DGBTVAR("A"),"^",2),",",2)_" "_$P($P(DGBTVAR("A"),"^",2),",") 48 Q 49 CITY S DGBTCSZ=DGBTCNA 50 S:VAPA(5)'="" DGBTCNU=$O(^DGBT(392.1,"ACS",DGBTCNA,+VAPA(5),0)) 51 I $D(DGBTCNU),(DGBTCNU'="") S DGBTCSZ=$P(^DGBT(392.1,DGBTCNU,0),"^")_", "_($P(^DIC(5,+VAPA(5),0),"^",2))_" "_($P(^DGBT(392.1,DGBTCNU,0),"^",4)) 52 Q 53 QUE ; 54 N I 55 S ZTRTN="PRINT^DGBTCR",ZTDESC="VA FORM 70-3542d" 56 F I="DFN","DGBTDT","DGBTFCTY","DGBTTCTY" S ZTSAVE(I)="" 57 D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK 58 D HOME^%ZIS K IO("Q") 59 Q 1 DGBTCR ;ALB/SCK - BENEFICIARY TRAVEL FORM 70-3542d VARIABLES; 2/7/88@08:00 ;6/11/93@09:30 2 ;;1.0;Beneficiary Travel;**7**;September 25, 2001 3 ;Modification of AIVBTPRT / pmg / GRAND ISLAND ; 07 Jul 88 12:02 PM 4 START Q:'$D(DGBTDT) 5 S DGBTVAR(0)=$G(^DGBT(392,+DGBTDT,0)),DGBTACCT=$P($G(^DGBT(392.3,+$P(DGBTVAR(0),"^",6),0)),"^",5) 6 Q:DGBTACCT'>3 7 W !!,*7,"This needs to be printed at 132 columns" 8 S DGPGM="PRINT^DGBTCR",DGVAR="DGBTDT" 9 S %ZIS="PMQ" D ^%ZIS G QUIT:POP 10 I $D(IO("Q")) D QUE G QUIT 11 D PRINT 12 QUIT ; 13 D:'$D(ZTQUEUED) ^%ZISC 14 K DGPGM,DGVAR,VADAT,VADATE,I,X,X2,DGBTVAR,DGBTCC,DGBTDIV,DGBTDOB,DGBTINS,DGBTINS1,DGBTINS2,DGBTCNA,DGBTCSZ,DGBTCNU,DGBTTCTY,DGBTFCTY,DGBTDT,DGBTACCT,DFN,Y 15 K DGBTM6,DGBTM7,DGBTM8,DGBTM9,DGBTM10,DGBTM11,DGBTM12,DGBTM13,DGBTM14,DGBTM15,DGBTM16,DGBTM17,DGBTRATE,DGBTSCP,DGBTSSN,DGBTST 16 Q 17 PRINT ; 18 U IO D SET,PRINT^DGBTCR1,PRINT^DGBTCR2,KVAR^VADPT 19 Q 20 SET S DFN=$P(^DGBT(392,DGBTDT,0),"^",2) D 6^VADPT S (DGBTFCTY,DGBTTCTY)="" 21 NODES F I=0,"A","D","M","R","T" S DGBTVAR(I)=$S($D(^DGBT(392,DGBTDT,I)):^(I),1:"") 22 I $D(^DG(43.1,$O(^DG(43.1,(9999999.99999-DGBTDT))),"BT")) S DGBTRATE=^("BT"),DGBTM7=$S($P(DGBTVAR("A"),"^",3)=1:$P(DGBTRATE,"^",5),1:$P(DGBTRATE,"^",3)) 23 I $P(DGBTVAR("D"),"^",4)]"" S DGBTCNA=$P(DGBTVAR("D"),"^",4) D CITY I DGBTCSZ[DGBTCNA D 24 . S DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("D"),"^",5)>0:$P(^DIC(5,$P(DGBTVAR("D"),"^",5),0),U,2),1:"")_" " 25 . S Y=$P(DGBTVAR("D"),U,6),Y=$E(Y,1,5)_$S($E(Y,6,9)]"":"-"_$E(Y,6,9),1:""),DGBTCSZ=DGBTCSZ_Y,DGBTFCTY=DGBTCSZ 26 I $P(DGBTVAR("T"),"^",4)]"" S DGBTCNA=$P(DGBTVAR("T"),U,4) D CITY^DGBTCR S:DGBTCSZ[DGBTCNA DGBTCSZ=DGBTCNA_", "_$S(+$P(DGBTVAR("T"),"^",5)>0:$P(^DIC(5,$P(DGBTVAR("T"),"^",5),0),U,2),1:"")_" "_$P(DGBTVAR("T"),U,6) S DGBTTCTY=DGBTCSZ 27 DIV S DGBTDIV=$P(DGBTVAR(0),"^",11) I +DGBTDIV S DGBTDIV=$P(^DG(40.8,DGBTDIV,0),"^",7) S (DGBTCC,DGBTST)="" 28 I $D(^DIC(4,+DGBTDIV,0)) S DGBTINS=^(0),DGBTINS1=$S($D(^DIC(4,DGBTDIV,1)):^(1),1:""),DGBTINS2=$S(DGBTINS1]"":$P(DGBTINS1,"^",3)_",",1:"UNSPECIFIED")_" "_$S($D(^DIC(5,+$P(DGBTINS,U,2),0)):$P(^(0),U,2),1:"")_" "_$P(DGBTINS1,"^",4) 29 I VAPA(5)&(VAPA(7)) S DGBTCC=$S($D(^DIC(5,+VAPA(5),1,+VAPA(7),0)):$P(^(0),"^",3),1:""),DGBTST=$P(^DIC(5,+VAPA(5),0),"^",2) 30 ;S DGBTSSN=$P($P(VADM(2),"^",2),"-")_" "_$P($P(VADM(2),"^",2),"-",2)_" "_$P($P(VADM(2),"^",2),"-",3),DGBTDOB=$E(VADM(3),4,7)_$E(VADM(3),2,3) 31 D PID^VADPT6 S DGBTSSN=VA("PID"),DGBTDOB=$E(VADM(3),4,7)_($E(VADM(3),1,3)+1700) 32 S DGBTSCP=$S($L($P(VAEL(3),"^",2)<3):"0",1:"")_$P(VAEL(3),"^",2) 33 MILES S DGBTM6=$P(DGBTVAR("M"),"^")*$P(DGBTVAR("M"),"^",2) 34 N X3 35 S X2="2$",X=DGBTM6*DGBTM7 D COMMA^%DTC S DGBTM8=X 36 S X=$P(DGBTVAR("M"),"^",4) D COMMA^%DTC S DGBTM9=X 37 S X=$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM10=X 38 S X=DGBTM6*DGBTM7+$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR("M"),"^",5) D COMMA^%DTC S DGBTM11=X 39 S X=DGBTM7 D COMMA^%DTC S DGBTM7=X 40 S X=$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM12=X 41 S X=$P(DGBTVAR("M"),"^",4)+$P(DGBTVAR(0),"^",8) D COMMA^%DTC S DGBTM13=X 42 S X=$P(DGBTVAR(0),"^",10) D COMMA^%DTC S DGBTM14=X 43 S X=$P(DGBTVAR(0),"^",9) D COMMA^%DTC S $P(DGBTM14,"^",2)=X 44 CERT S VADAT("W")=DGBTDT D ^VADATE S DGBTM15=VADATE("E") 45 S X=$S($P(^DG(43,1,"BT"),"^")'="":$P(^DG(43,1,"BT"),"^"),1:DUZ),DGBTM16=$P($P(^VA(200,X,0),",",2),"^")_" "_$P(^VA(200,X,0),",")_$S($P(^DG(43,1,"BT"),"^")'="":"",1:", DESIGNEE OF CERTIFYING OFFICIAL") K X 46 S DGBTM17=$P($P(DGBTVAR("A"),"^",2),",",2)_" "_$P($P(DGBTVAR("A"),"^",2),",") 47 Q 48 CITY S DGBTCSZ=DGBTCNA 49 S:VAPA(5)'="" DGBTCNU=$O(^DGBT(392.1,"ACS",DGBTCNA,+VAPA(5),0)) 50 I $D(DGBTCNU),(DGBTCNU'="") S DGBTCSZ=$P(^DGBT(392.1,DGBTCNU,0),"^")_", "_($P(^DIC(5,+VAPA(5),0),"^",2))_" "_($P(^DGBT(392.1,DGBTCNU,0),"^",4)) 51 Q 52 QUE ; 53 N I 54 S ZTRTN="PRINT^DGBTCR",ZTDESC="VA FORM 70-3542d" 55 F I="DFN","DGBTDT","DGBTFCTY","DGBTTCTY" S ZTSAVE(I)="" 56 D ^%ZTLOAD W:$D(ZTSK) !,"TASK #",ZTSK 57 D HOME^%ZIS K IO("Q") 58 Q
Note:
See TracChangeset
for help on using the changeset viewer.
