| 1 | DGOVBC ;ALB/MRL - VBC DRIVER ROUTINE ; 12 FEB 87
|
|---|
| 2 | ;;5.3;Registration;**162,279**;Aug 13, 1993
|
|---|
| 3 | W ! D DT^DICRW S IOP="HOME" D ^%ZIS K IOP I $D(IOF),IOF']"" W @IOF
|
|---|
| 4 | 1 W ! S DGHOW="S",VAUTNALL="",VAUTNI=2,DIC("S")="S DG36=$S($D(^(.36)):^(.36),1:0) I $S('DG36:1,'$D(^DIC(8,+$P(DG36,U,1),0)):1,$P(^DIC(8,+$P(DG36,U,1),0),U,5)=""Y"":1,1:0)" D PATIENT^VAUTOMA I Y<0 G Q^DGOVBC1
|
|---|
| 5 | P W !!,"DISPLAY THE FOLLOWING PATIENTS",!,"------------------------------" S DFN=0 F DFN1=0:0 S DFN=$O(VAUTN(DFN)) Q:DFN="" I $D(^DPT(DFN,0)) S X=^(0),Y=$P(X,"^",3) X:Y]"" ^DD("DD") W !,$P(X,"^",1),?40,Y,?60,$P(X,"^",9)
|
|---|
| 6 | OK W !!,"IS THIS CORRECT" S %=2 D YN^DICN G QUE:%=1,Q^DGOVBC1:%=2!(%=-1) W !!?4,"Y - If you want to see VBC data for these patients.",!?4,"N - If you want to QUIT and reconsider this action." G OK
|
|---|
| 7 | 2 W ! F I=1:1 S J=$P($T(T+I),";;",2) Q:J']"" W !,J
|
|---|
| 8 | D DT^DICRW W !! S DGHOW="A",%DT="EAX",%DT("A")="Start with ADMISSION DATE: " D ^%DT G Q^DGOVBC1:Y'>0 S (DGFR,DGHFR)=Y,X1=DGFR,X2=-1 D C^%DTC S DGFR=X_".9999"
|
|---|
| 9 | D S Y=DT,%DT(0)=DGHFR K DGHFR X ^DD("DD") S %DT("A")=" Go to ADMISSION DATE: "_Y_"// " D ^%DT I X']"" S DGTO=DT_".9999" G M
|
|---|
| 10 | G Q^DGOVBC1:Y'>0 S DGTO=Y_".9999" I DGFR>DGTO W !?4,"TO DATE CAN'T BE BEFORE FROM DATE!!",*7,! G D
|
|---|
| 11 | M S DGDFN=DGFR_"^"_DGTO
|
|---|
| 12 | ;Ask division (sets VAUTD)
|
|---|
| 13 | W ! Q:'$$ASKDIV^DGUTL()
|
|---|
| 14 | QUE W !!,*7,"Note: This report requires a column width of 132." S DGPGM=DGHOW_"^DGOVBC",DGVAR="DUZ^DGDFN^VAUTN#^VAUTD#" D ZIS^DGUTQ G Q^DGOVBC1:POP U IO
|
|---|
| 15 | G @DGPGM
|
|---|
| 16 | S D SET S DFN=0 F DFN1=0:0 S DFN=$O(VAUTN(DFN)) Q:DFN="" I $D(^DPT(DFN,0)),$P(^(0),"^",1)]"" S ^UTILITY($J,"DGOVBC",$P(^DPT(DFN,0),"^",1))=DFN
|
|---|
| 17 | G ^DGOVBC1
|
|---|
| 18 | A D SET S DGFR=$P(DGDFN,"^",1),DGTO=$P(DGDFN,"^",2) F I=0:0 S DGFR=$O(^DGPM("AMV1",DGFR)) Q:'DGFR!(DGFR>DGTO) F DFN=0:0 S DFN=$O(^DGPM("AMV1",DGFR,DFN)) Q:'DFN F DGCA=0:0 S DGCA=$O(^DGPM("AMV1",DGFR,DFN,DGCA)) Q:'DGCA I $D(^DGPM(DGCA,0)) D A1
|
|---|
| 19 | G ^DGOVBC1
|
|---|
| 20 | A1 I $D(^DPT(DFN,0)),$P(^(0),"^",1)]"",$D(^DPT(DFN,.36)) S X=$P(^(.36),"^",1) I $D(^DIC(8,+X,0)),$P(^(0),"^",5)="Y" D
|
|---|
| 21 | .I 'VAUTD S DGWD=+$P($G(^DGPM(DGCA,0)),U,6) Q:'DGWD S DGWD=+$P($G(^DIC(42,DGWD,0)),U,11) Q:'$D(VAUTD(DGWD))
|
|---|
| 22 | .S ^UTILITY($J,"DGOVBC",$P(^DPT(DFN,0),"^",1))=DFN
|
|---|
| 23 | Q
|
|---|
| 24 | SET S U="^",DGHD=$S($D(^DD("SITE"))#2:^("SITE"),1:"")_$S($D(^DD("SITE",1)):" ("_^(1)_")",1:""),DGHD1=1-$L(DGHD)-1,DGLIN="",$P(DGLIN,"=",131)="" K ^UTILITY($J,"DGOVBC") Q
|
|---|
| 25 | ERR S Y=-1 K DIC,SDALL,SDEF Q
|
|---|
| 26 | T ;
|
|---|
| 27 | ;;This option is used to generate the 'VETERANS ASSISTANCE UNIT RECORD' for any
|
|---|
| 28 | ;;veterans admitted during a specified date range. The user will be prompted to
|
|---|
| 29 | ;;select the 'Start with' and 'Go To' range for admissions and the DEVICE desired
|
|---|
| 30 | ;;for output. A VBC document will be generated only for those patients admitted
|
|---|
| 31 | ;;during the requested timeframe who are veterans.
|
|---|
