- DGOVBC1 ;ALB/MRL - VBC OUTPUT ; 12 FEB 87
- ;;5.3;Registration;**162,489,1015**;Aug 13, 1993;Build 21
- N VAPA
- K DGLN S $P(DGLN," ",80)="",DGU="UNKNOWN",DGPP=""
- F DGPP1=0:0 S DGPP=$O(^UTILITY($J,"DGOVBC",DGPP)) Q:(DGPP="")!($G(ZTSTOP)=1) S DFN=^UTILITY($J,"DGOVBC",DGPP) D DIS,ENDREP^DGUTL
- Q K DGCA,I,DGX,X,Y,%DT,DGFR,DGHD,DGHD1,DGHOW,DGIOM,DGLIN,DGLN,DGPP,DGPP1,DGTO,DGU,DGVAR,DIC,DFN,DGCT,DGDFN,DGP,DGPGM,ZTSTOP,^UTILITY($J,"DGOVBC") D CLOSE^DGUTQ Q
- G Q^DGOVBC2
- DIS I $$FIRST^DGUTL Q
- D NOW^%DTC S Y=$E(%,1,12) W !,"VETERANS ASSISTANCE UNIT RECORD",?53,"PRINTED: ",$$FMTE^XLFDT(Y,1),?DGHD1,DGHD,!,DGLIN,! K Y
- D DEM^VADPT D L W !,"1. Patient Name: ",$S(VADM(1)]"":VADM(1),1:"UNSPECIFIED PATIENT #"_DFN),?55,"| 2. DOB: ",$P(VADM(3),"^",2)
- D PID^VADPT6 W ?80,"| 3. PT ID: ",$S(VA("PID"):VA("PID"),1:DGU),?106,"| 4. Claim #: " S DGMS=$S(VADM(10):$P(VADM(10),"^",2),1:DGU) K VA,VADM D ELIG^VADPT W $S(VAEL(7):VAEL(7),1:DGU),! S DGSC=+VAEL(3),DGMT=$P(VAEL(9),"^",2) K VAEL
- W "_______________________________________________________|________________________|_________________________|_______________________"
- D ADD^VADPT,A W !,"5. Address Information [Street, City, State, Zip Code]:" F I=0:0 S I=$O(DGA(I)) Q:'I W:I>1 ! W ?57,DGA(I),!
- I VAPA(12)=1 D
- .D L
- .D AC W !,"5A. Confidential Address Information [Street, City, State, Zip Code]:" F I=0:0 S I=$O(DGA(I)) Q:'I W:I>1 ! W ?57,DGA(I)
- K DGA W ! D SVC^VADPT,L W !,"6. Service Record",?35,"Service #",?55,"Entry Date",?75,"Separation Date",?108,"Discharge Type"
- W $C(13)," ","______________",$E(DGLN,1,18),"_________",$E(DGLN,1,11),"__________",$E(DGLN,1,10),"_______________",$E(DGLN,1,18),"______________" S DGPOW=VASV(4)
- F I=6:1:8 I VASV(I) W !?3,$S(VASV(I,1):$P(VASV(I,1),"^",2),1:DGU),?35,$S($L(VASV(I,2)):VASV(I,2),1:DGU),?55,$S('VASV(I,4):DGU,1:$P(VASV(I,4),"^",2)),?75,$S('VASV(I,5):DGU,1:$P(VASV(I,5),"^",2)),?108,$S(VASV(I,3):$P(VASV(I,3),"^",2),1:DGU)
- K VASV W ! D L S DGCT=0 F I=0:0 S I=$O(^DGPM("ATID1",DFN,I)) Q:'I!(DGCT=2) F DGCA=0:0 S DGCA=$O(^DGPM("ATID1",DFN,I,DGCA)) Q:'DGCA!(DGCT=2) I $D(^DGPM(DGCA,0)) S DGCT=DGCT+1,DGADM(DGCT)=^(0),DGADM(DGCT,4)=$P(^(0),"^",12)
- S DGSCOND=0 W !,"7. Admission Date" I 'DGCT W ": NO ADMISSIONS ON FILE FOR THIS APPLICANT." G ^DGOVBC2
- W ?20,"Admission Type",?55,"Ward",?70,"Admitting Diagnosis",?105,"Admission Authority"
- W $C(13)," ","______________"," ","______________",$E(DGLN,1,21),"____",$E(DGLN,1,11),"___________________",$E(DGLN,1,16),"___________________"
- F I=1:1:DGCT S DGD=DGADM(I),DGD1=DGADM(I,4) D AS W !?3,DGD(1),?20,DGD(2),?55,$E(DGD(3),1,10),?70,DGD(4),?105,$E(DGD(5),1,25)
- D H^DGUTL S DGT=DGTIME K DGTIME D ^DGINPW W !?4,"NOTE: ",$S('DG1:"NOT CURRENTLY AN INPATIENT.",1:$S($D(^DIC(42,+DG1,0)):"CURRENTLY AN INPATIENT ON WARD '"_$P(^(0),"^",1)_"'."),1:"INPATIENT ON UNKNOWN WARD.")
- I DGSCOND W !?4,"NOTE: Asterisk [*] indicates admission for Service Connected Condition."
- K DGSCOND G ^DGOVBC2
- L F DGL=1:1:$S($D(IOM):(IOM-2),1:130) W "_"
- Q
- PT F I=0,.11,.15,.3,.31,.32,.36,.361,.362,.52,"VET" S DGP(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
- S DGSC=$S($P(DGP(.3),"^",1)="Y":1,1:0) Q
- A S DGA=1 F I=1:1:3 Q:'$L(VAPA(I)) S:I=3 DGA(2)=DGA(2)_", "_VAPA(I) S:DGA<3 DGA(I)=VAPA(I),DGA=DGA+1
- I VAPA(1)']"" S DGA(1)="STREET ADDRESS UNKNOWN",DGA=2
- S DGA(DGA)=$S($L(VAPA(4))&(VAPA(5)):VAPA(4)_", "_$P(VAPA(5),"^",2),$L(VAPA(4)):VAPA(4),VAPA(5):$P(VAPA(5),"^",2),1:"CITY STATE UNKNOWN")
- S:$L(DGA(DGA)) DGA(DGA)=DGA(DGA)_" "_VAPA(6)
- I VAPA(12)=0 K I,J
- Q
- AC ;Formatting Confidential Address Information
- K DGA
- I VAPA(12)=1 D
- .N DGASEQ,SEQ
- .S DGA=13 F I=13:1:15 Q:'$L(VAPA(I)) S:I=15 DGA(14)=DGA(14)_", "_VAPA(I) S:DGA<15 DGA(I)=VAPA(I),DGA=DGA+1
- .S DGA(19)="______________________________________________"
- .S DGA(20)="Confidential Start Date: "_$P(VAPA(20),"^",2)
- .S DGA(21)="Confidential End Date: "_$P(VAPA(21),"^",2)
- .S DGA(22)="Confidential Address Categories:"
- .S SEQ="",DGASEQ=23 F S SEQ=$O(VAPA(22,SEQ)) Q:SEQ="" D
- ..I $P(VAPA(22,SEQ),"^",3)="Y" S DGA(DGASEQ)=$P(VAPA(22,SEQ),"^",2),DGASEQ=DGASEQ+1
- .I VAPA(13)']"" S DGA(1)="STREET ADDRESS UNKNOWN",DGA=2
- .S DGA(DGA)=$S($L(VAPA(16))&(VAPA(17)):VAPA(16)_", "_$P(VAPA(17),"^",2),$L(VAPA(16)):VAPA(16),VAPA(17):$P(VAPA(17),"^",2),1:"CITY STATE UNKNOWN")
- .S:$L(DGA(DGA)) DGA(DGA)=DGA(DGA)_" "_$P(VAPA(18),"^",2)
- K I,VAPA Q
- Q
- AS S Y=$P(DGD,"^",1),Y=$P(Y,".",1) X ^DD("DD") S:$P(DGD,"^",11) DGSCOND=1 S DGD(1)=$S($P(DGD,"^",11):"*",1:" ")_Y,DGD(2)=$S($D(^DG(405.2,+$P(DGD,"^",18),0)):$P(^(0),"^",1),1:DGU)
- S DGD(3)=$S($D(^DIC(42,+$P(DGD,"^",6),0)):$P(^(0),"^",1),1:DGU)
- S DGD(4)=$S($P(DGD,"^",10)]"":$E($P(DGD,"^",10),1,30),1:"ADMITTING DIAGNOSIS UNSPECIFIED"),DGD(5)=$S($D(^DIC(43.4,+$P(DGADM(I,4),"^",1),0)):$P(^(0),"^",1),1:DGU) Q
- DGOVBC1 ;ALB/MRL - VBC OUTPUT ; 12 FEB 87
- +1 ;;5.3;Registration;**162,489,1015**;Aug 13, 1993;Build 21
- +2 NEW VAPA
- +3 KILL DGLN
- SET $PIECE(DGLN," ",80)=""
- SET DGU="UNKNOWN"
- SET DGPP=""
- +4 FOR DGPP1=0:0
- SET DGPP=$ORDER(^UTILITY($JOB,"DGOVBC",DGPP))
- IF (DGPP="")!($GET(ZTSTOP)=1)
- QUIT
- SET DFN=^UTILITY($JOB,"DGOVBC",DGPP)
- DO DIS
- DO ENDREP^DGUTL
- Q KILL DGCA,I,DGX,X,Y,%DT,DGFR,DGHD,DGHD1,DGHOW,DGIOM,DGLIN,DGLN,DGPP,DGPP1,DGTO,DGU,DGVAR,DIC,DFN,DGCT,DGDFN,DGP,DGPGM,ZTSTOP,^UTILITY($JOB,"DGOVBC")
- DO CLOSE^DGUTQ
- QUIT
- +1 GOTO Q^DGOVBC2
- DIS IF $$FIRST^DGUTL
- QUIT
- +1 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- WRITE !,"VETERANS ASSISTANCE UNIT RECORD",?53,"PRINTED: ",$$FMTE^XLFDT(Y,1),?DGHD1,DGHD,!,DGLIN,!
- KILL Y
- +2 DO DEM^VADPT
- DO L
- WRITE !,"1. Patient Name: ",$SELECT(VADM(1)]"":VADM(1),1:"UNSPECIFIED PATIENT #"_DFN),?55,"| 2. DOB: ",$PIECE(VADM(3),"^",2)
- +3 DO PID^VADPT6
- WRITE ?80,"| 3. PT ID: ",$SELECT(VA("PID"):VA("PID"),1:DGU),?106,"| 4. Claim #: "
- SET DGMS=$SELECT(VADM(10):$PIECE(VADM(10),"^",2),1:DGU)
- KILL VA,VADM
- DO ELIG^VADPT
- WRITE $SELECT(VAEL(7):VAEL(7),1:DGU),!
- SET DGSC=+VAEL(3)
- SET DGMT=$PIECE(VAEL(9),"^",2)
- KILL VAEL
- +4 WRITE "_______________________________________________________|________________________|_________________________|_______________________"
- +5 DO ADD^VADPT
- DO A
- WRITE !,"5. Address Information [Street, City, State, Zip Code]:"
- FOR I=0:0
- SET I=$ORDER(DGA(I))
- IF 'I
- QUIT
- IF I>1
- WRITE !
- WRITE ?57,DGA(I),!
- +6 IF VAPA(12)=1
- Begin DoDot:1
- +7 DO L
- +8 DO AC
- WRITE !,"5A. Confidential Address Information [Street, City, State, Zip Code]:"
- FOR I=0:0
- SET I=$ORDER(DGA(I))
- IF 'I
- QUIT
- IF I>1
- WRITE !
- WRITE ?57,DGA(I)
- End DoDot:1
- +9 KILL DGA
- WRITE !
- DO SVC^VADPT
- DO L
- WRITE !,"6. Service Record",?35,"Service #",?55,"Entry Date",?75,"Separation Date",?108,"Discharge Type"
- +10 WRITE $CHAR(13)," ","______________",$EXTRACT(DGLN,1,18),"_________",$EXTRACT(DGLN,1,11),"__________",$EXTRACT(DGLN,1,10),"_______________",$EXTRACT(DGLN,1,18),"______________"
- SET DGPOW=VASV(4)
- +11 FOR I=6:1:8
- IF VASV(I)
- WRITE !?3,$SELECT(VASV(I,1):$PIECE(VASV(I,1),"^",2),1:DGU),?35,$SELECT($LENGTH(VASV(I,2)):VASV(I,2),1:DGU),?55,$SELECT('VASV(I,4):DGU,1:$PIECE(VASV(I,4),"^",2)),?75,$SELECT('VASV(I,5):DGU,1:...
- ... $PIECE(VASV(I,5),"^",2)),?108,$SELECT(VASV(I,3):$PIECE(VASV(I,3),"^",2),1:DGU)
- +12 KILL VASV
- WRITE !
- DO L
- SET DGCT=0
- FOR I=0:0
- SET I=$ORDER(^DGPM("ATID1",DFN,I))
- IF 'I!(DGCT=2)
- QUIT
- FOR DGCA=0:0
- SET DGCA=$ORDER(^DGPM("ATID1",DFN,I,DGCA))
- IF 'DGCA!(DGCT=2)
- QUIT
- IF $DATA(^DGPM(DGCA,0))
- SET DGCT=DGCT+1
- SET DGADM(DGCT)=^(0)
- SET DGADM(DGCT,4)=$PIECE(^(0),"^",12)
- +13 SET DGSCOND=0
- WRITE !,"7. Admission Date"
- IF 'DGCT
- WRITE ": NO ADMISSIONS ON FILE FOR THIS APPLICANT."
- GOTO ^DGOVBC2
- +14 WRITE ?20,"Admission Type",?55,"Ward",?70,"Admitting Diagnosis",?105,"Admission Authority"
- +15 WRITE $CHAR(13)," ","______________"," ","______________",$EXTRACT(DGLN,1,21),"____",$EXTRACT(DGLN,1,11),"___________________",$EXTRACT(DGLN,1,16),"___________________"
- +16 FOR I=1:1:DGCT
- SET DGD=DGADM(I)
- SET DGD1=DGADM(I,4)
- DO AS
- WRITE !?3,DGD(1),?20,DGD(2),?55,$EXTRACT(DGD(3),1,10),?70,DGD(4),?105,$EXTRACT(DGD(5),1,25)
- +17 DO H^DGUTL
- SET DGT=DGTIME
- KILL DGTIME
- DO ^DGINPW
- WRITE !?4,"NOTE: ",$SELECT('DG1:"NOT CURRENTLY AN INPATIENT.",1:$SELECT($DATA(^DIC(42,+DG1,0)):"CURRENTLY AN INPATIENT ON WARD '"_$PIECE(^(0),"^",1)_"'."),1:"INPATIENT ON UNKNOWN WARD.")
- +18 IF DGSCOND
- WRITE !?4,"NOTE: Asterisk [*] indicates admission for Service Connected Condition."
- +19 KILL DGSCOND
- GOTO ^DGOVBC2
- L FOR DGL=1:1:$SELECT($DATA(IOM):(IOM-2),1:130)
- WRITE "_"
- +1 QUIT
- PT FOR I=0,.11,.15,.3,.31,.32,.36,.361,.362,.52,"VET"
- SET DGP(I)=$SELECT($DATA(^DPT(DFN,I)):^(I),1:"")
- +1 SET DGSC=$SELECT($PIECE(DGP(.3),"^",1)="Y":1,1:0)
- QUIT
- A SET DGA=1
- FOR I=1:1:3
- IF '$LENGTH(VAPA(I))
- QUIT
- IF I=3
- SET DGA(2)=DGA(2)_", "_VAPA(I)
- IF DGA<3
- SET DGA(I)=VAPA(I)
- SET DGA=DGA+1
- +1 IF VAPA(1)']""
- SET DGA(1)="STREET ADDRESS UNKNOWN"
- SET DGA=2
- +2 SET DGA(DGA)=$SELECT($LENGTH(VAPA(4))&(VAPA(5)):VAPA(4)_", "_$PIECE(VAPA(5),"^",2),$LENGTH(VAPA(4)):VAPA(4),VAPA(5):$PIECE(VAPA(5),"^",2),1:"CITY STATE UNKNOWN")
- +3 IF $LENGTH(DGA(DGA))
- SET DGA(DGA)=DGA(DGA)_" "_VAPA(6)
- +4 IF VAPA(12)=0
- KILL I,J
- +5 QUIT
- AC ;Formatting Confidential Address Information
- +1 KILL DGA
- +2 IF VAPA(12)=1
- Begin DoDot:1
- +3 NEW DGASEQ,SEQ
- +4 SET DGA=13
- FOR I=13:1:15
- IF '$LENGTH(VAPA(I))
- QUIT
- IF I=15
- SET DGA(14)=DGA(14)_", "_VAPA(I)
- IF DGA<15
- SET DGA(I)=VAPA(I)
- SET DGA=DGA+1
- +5 SET DGA(19)="______________________________________________"
- +6 SET DGA(20)="Confidential Start Date: "_$PIECE(VAPA(20),"^",2)
- +7 SET DGA(21)="Confidential End Date: "_$PIECE(VAPA(21),"^",2)
- +8 SET DGA(22)="Confidential Address Categories:"
- +9 SET SEQ=""
- SET DGASEQ=23
- FOR
- SET SEQ=$ORDER(VAPA(22,SEQ))
- IF SEQ=""
- QUIT
- Begin DoDot:2
- +10 IF $PIECE(VAPA(22,SEQ),"^",3)="Y"
- SET DGA(DGASEQ)=$PIECE(VAPA(22,SEQ),"^",2)
- SET DGASEQ=DGASEQ+1
- End DoDot:2
- +11 IF VAPA(13)']""
- SET DGA(1)="STREET ADDRESS UNKNOWN"
- SET DGA=2
- +12 SET DGA(DGA)=$SELECT($LENGTH(VAPA(16))&(VAPA(17)):VAPA(16)_", "_$PIECE(VAPA(17),"^",2),$LENGTH(VAPA(16)):VAPA(16),VAPA(17):$PIECE(VAPA(17),"^",2),1:"CITY STATE UNKNOWN")
- +13 IF $LENGTH(DGA(DGA))
- SET DGA(DGA)=DGA(DGA)_" "_$PIECE(VAPA(18),"^",2)
- End DoDot:1
- +14 KILL I,VAPA
- QUIT
- +15 QUIT
- AS SET Y=$PIECE(DGD,"^",1)
- SET Y=$PIECE(Y,".",1)
- XECUTE ^DD("DD")
- IF $PIECE(DGD,"^",11)
- SET DGSCOND=1
- SET DGD(1)=$SELECT($PIECE(DGD,"^",11):"*",1:" ")_Y
- SET DGD(2)=$SELECT($DATA(^DG(405.2,+$PIECE(DGD,"^",18),0)):$PIECE(^(0),"^",1),1:DGU)
- +1 SET DGD(3)=$SELECT($DATA(^DIC(42,+$PIECE(DGD,"^",6),0)):$PIECE(^(0),"^",1),1:DGU)
- +2 SET DGD(4)=$SELECT($PIECE(DGD,"^",10)]"":$EXTRACT($PIECE(DGD,"^",10),1,30),1:"ADMITTING DIAGNOSIS UNSPECIFIED")
- SET DGD(5)=$SELECT($DATA(^DIC(43.4,+$PIECE(DGADM(I,4),"^",1),0)):$PIECE(^(0),"^",1),1:DGU)
- QUIT
