source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGOINS1.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1DGOINS1 ;ALB/MAC - OUTPUT FOR PATIENTS ADMITTED WITH UNKNOWN INSURANCE ; SEP 12 1988@1:00
2 ;;5.3;Registration;**162**;Aug 13, 1993
3START D NOW^%DTC S Y=$E(%,1,12),DGDT=$$FMTE^XLFDT(Y,1),(DGN,DGC,DGU,DGV)="",$P(DGCL,"*",81)="",L=1 F X=1:1:4 S DGS(X)=0
4 I DGL="C" S DGW=0 F X1=0:0 S DGW=$O(^DPT("CN",DGW)) Q:DGW="" F DFN=0:0 S DFN=$O(^DPT("CN",DGW,DFN)) Q:DFN="" S DGCA=^(DFN) I $D(^DGPM(+DGCA,0)),$P(^DGPM(+DGCA,0),"^",2)=1 D UTIL
5 I DGL="C" G PP
6SR F DGD=DGBEG1:0 S DGD=$O(^DGPM("AMV1",DGD)) Q:(DGD="")!(DGD\1>DGEND1) F DFN=0:0 S DFN=$O(^DGPM("AMV1",DGD,DFN)) Q:DFN="" F DGCA=0:0 S DGCA=$O(^DGPM("AMV1",DGD,DFN,DGCA)) Q:DGCA="" D UTIL
7PP I '$D(^UTILITY($J,"DGM")) S DGD=1 W !,"=====>NO PATIENTS FOUND" G QUIT
8 S DGDV=0 F K=0:0 S DGDV=$O(^UTILITY($J,"DGM",DGDV)) Q:DGDV=""!(DGU) D TT Q:DGU D HEAD S DGP=0 F DGJ=0:0 S DGP=$O(^UTILITY($J,"DGM",DGDV,DGP)) Q:DGP=""!(DGU) S DGV=DGDV F DGD=0:0 S DGD=$O(^UTILITY($J,"DGM",DGDV,DGP,DGD)) Q:DGD=""!(DGU) D LP
9 G QUIT:DGU D TT G QUIT:DGU
10 I DGS(3)>0!(DGS(4)>0) D MC
11 F K=0:0 S K=$O(DGL(K)) Q:K=""!(DGU) S DGL=DGL(K) W !!,"DIVISION: ",$P(DGL,"^",1),!!?10,"Number of unknown",?34,": ",$J($P(DGL,"^",3),5),!?9,"#Number of unanswered",?34,": ",$J($P(DGL,"^",2),5) I IOST?1"C-".E&($Y+7>IOSL) D RT,MC
12 G QUIT:DGU I DGS(3)>0!(DGS(4)>0) W !!?5,"MEDICAL CENTER:",!?10,"Total number of unknown",?34,": ",$J(DGS(4),5),!?9,"#Total number unanswered",?34,": ",$J(DGS(3),5),!?36,"-----",!?29,"TOTAL",?34,": ",$J(DGS(4)+DGS(3),5) W !! D NT
13QUIT D CLOSE^DGUTQ Q
14LP F DFN=0:0 S DFN=$O(^UTILITY($J,"DGM",DGDV,DGP,DGD,DFN)) Q:DFN=""!(DGU) D PRINT,CT
15 Q
16UTIL I $D(^DPT(DFN,.3)) Q:(DGSC=2)&($P(^(.3),"^",1)="Y")
17 Q:'$D(^DGPM(DGCA,0)) S DGNO=^(0) S:DGL="C" DGD=$P(DGNO,"^",1) D INP^VADPT S X=+VAIN(4) K VAIN
18 Q:'$D(^DIC(42,+X,0)) S Y=$P(^DIC(42,X,0),"^",11) G:Y="" UT Q:'VAUTD&('$D(VAUTD(Y)))
19UT I $D(^DPT(DFN,.31)) S X=$P(^(.31),"^",11) Q:X="Y"!(X="N")
20 S DGP=$P(^DPT(DFN,0),"^",1) S DGDV=$S(Y="":"ZNOT SPECIFIED",1:$P(^DG(40.8,Y,0),"^",1))
21 S ^UTILITY($J,"DGM",DGDV,DGP,DGD,DFN)=""
22 Q
23CT I '$D(^DPT(DFN,.31)) S DGS(3)=DGS(3)+1,DGS(1)=DGS(1)+1 Q
24 S X=$P(^DPT(DFN,.31),"^",11) I X="" S DGS(3)=DGS(3)+1,DGS(1)=DGS(1)+1 Q
25 S DGS(4)=DGS(4)+1,DGS(2)=DGS(2)+1 Q
26TT S DGV=$S(DGV="ZNOT SPECIFIED":"NOT SPECIFIED",1:DGV) I $Y+6>IOSL&(DGS(1)>0)!($Y+6>IOSL&(DGS(2)>0)) D:IOST?1"C-".E RT Q:DGU S DGC=DGC+1 W @IOF,!?3,"DIVISION: ",DGV,?50,DGDT," PAGE ",DGC,!!?22,"DIVISION SUMMARY FOR" D HEAD2 W !!,DGCL
27 I DGS(1)>0!DGS(2)>0 W !!!?3,"DIVISION: ",DGV,!?5,"Number of Unknown: ",$J(DGS(2),5),!?4,"#Number Unanswered: ",$J(DGS(1),5),?40 D NT S DGL(L)="",DGL(L)=DGV_"^"_DGS(1)_"^"_DGS(2),L=L+1,(DGS(1),DGS(2))=0 D:IOST?1"C-".E RT S DGC=0 Q
28 S DGC=0 Q
29PRINT I $Y+4>IOSL D:IOST?1"C-".E RT Q:DGU D HEAD
30 S X=+$P(^DPT(DFN,0),"^",3) I X S X=$$FMTE^XLFDT(X,"5DF"),X=$TR(X," ","0"),X=$TR(X,"/","-")
31 D PID^VADPT6 W !,$S('$D(^DPT(DFN,.31)):"#",$P(^DPT(DFN,.31),"^",11)="":"#",1:" ")_DGP,?27 W:VA("PID")]"" VA("PID") W ?40,X,?52 W:$D(^DPT(DFN,"VET")) $J(^("VET")_$S(^("VET")="Y":"ES",^("VET")="N":"O",1:""),3)
32 W ?57 S X=$P($S($D(^DPT(DFN,.3)):^(.3),1:""),"^",1),X=$P(X,"^",1) W:X]"" $J(X_$S(X="Y":"ES",1:"O"),3) W ?62 S Y=DGD X ^DD("DD") W $P(Y,"@",1)_"@"_$E($P(Y,"@",2),1,5)
33 Q
34HEAD S DGC=DGC+1 W @IOF,!?3,"DIVISION: ",$S(DGDV="ZNOT SPECIFIED":"NOT SPECIFIED",1:DGDV),?50,DGDT," PAGE ",DGC,!?31 D HEAD2
35 W !!?3,"PATIENT",?30,"PT ID",?43,"DOB",?52,"VET",?58,"SC",?63,"ADMISSION DATE",!,DGCL
36 Q
37HEAD2 W " ACTIVE PATIENTS",!?23,"WITH UNKNOWN/UNANSWERED INSURANCE",!
38 I DGL="C" S DGT="FOR "_$P(DGDT,"@",1)
39 I DGL="D" S DGT=$S(DGBEG=DGEND:"FOR ",1:"FROM "),DGT=DGT_$$FMTE^XLFDT(DGBEG,"1D") I DGEND'=DGBEG S DGT=DGT_" TO "_$$FMTE^XLFDT(DGEND,"1D")
40 S DGY=40-($L(DGT)/2) W ?DGY,DGT Q
41RT F X=$Y:1:(IOSL-2) W !
42 R !?22,"Enter <RET> to continue or ^ to QUIT",X:DTIME S:X["^"!('$T) DGU=1 Q:DGU=1
43 Q
44MC Q:DGU W @IOF,!?60,DGDT,!?19,"MEDICAL CENTER TOTALS FOR" D HEAD2 W !,DGCL Q
45NT W "# - Denotes prompt left blank by user" Q
Note: See TracBrowser for help on using the repository browser.