| [613] | 1 | DGPMVBUL ;ALB/MIR/MAC - SEND MOVEMENT BULLITENS; 12 Sep 1989
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;send UR admission bulletin
|
|---|
| 5 | D ^DGPMVBUR
|
|---|
| 6 | ;
|
|---|
| 7 | ;Send Unverified Eligibility Bulletin
|
|---|
| 8 | Q:'$D(DFN) D ^DGPATV S DGB=$S('DGVETS:7,'$D(^DPT(DFN,.361)):0,$P(^DPT(DFN,.361),"^",1)'="V":5,1:0) G EN:'DGB
|
|---|
| 9 | D INFO
|
|---|
| 10 | I '$D(DGPMDA) G EN
|
|---|
| 11 | S DGADMIT=$S($D(^DGPM(DGPMDA,0)):^(0),1:"") G EN:'DGADMIT S Y=+DGADMIT X ^DD("DD") S DGTEXT(DGC,0)="ADMITTED: "_Y,DGC=DGC+1
|
|---|
| 12 | S DGTEXT(DGC,0)=" TYPE: "_$S($D(^DG(405.1,+$P(DGADMIT,"^",4),0)):$P(^(0),"^",1),1:"UNKNOWN"),DGC=DGC+1,DGTEXT(DGC,0)=" WARD: "_$S($D(^DIC(42,+$P(DGADMIT,"^",6),0)):$P(^(0),"^",1),1:"UNKNOWN")
|
|---|
| 13 | I DGB=5 S DGC=DGC+1,DGTEXT(DGC,0)="",DGC=DGC+1,DGTEXT(DGC,0)="Veterans eligibility has not been verified yet." S DGC=DGC+1,DGTEXT(DGC,0)=""
|
|---|
| 14 | EN S DGFL=0 F DGI=0:0 S DGI=$O(^DGS(41.1,"B",DFN,DGI)) Q:'DGI S J=$S($D(^DGS(41.1,DGI,0)):^(0),1:0),Y=$P(J,"^",2) I Y X ^DD("DD") I '$P(J,"^",13),'$P(J,"^",17) D WR
|
|---|
| 15 | S DGFL=0 F X=0:0 S X=$O(^DGWAIT("C",DFN,X)) Q:'X S Y=$O(^(+X,0)) G T:('X)!('Y) I $D(^DGWAIT(X,"P",Y,0)) S I=^(0) D:'DGFL TEXT S DGC=DGC+1,DGG=$S($D(^DG(40.8,+^DGWAIT(X,0),0)):$E($P(^(0),"^",1),1,20),1:"") D CO
|
|---|
| 16 | T G Q:'$D(DGTEXT) S DGB=$S(DGB:DGB,1:5) D ^DGBUL
|
|---|
| 17 | Q K DGADMIT,DGB,DGC,DGFL,DGG,DGI,I,J,X,Y D KILL^DGPATV Q
|
|---|
| 18 | Q
|
|---|
| 19 | INFO I $D(DGC) S DGC=DGC+1 Q
|
|---|
| 20 | S XMSUB=$S('DGVETS:"NON-VETERAN ADMISSION",DGB=0:"FUTURE ACTIVITY SCHEDULED",1:"VETERAN ADMISSION WITHOUT VERIFIED ELIGIBILITY")
|
|---|
| 21 | S DGTEXT(1,0)="NAME: "_DGNAME,DGTEXT(2,0)="SSN : "_$P(SSN,"^",2),DGTEXT(3,0)="DOB : "_$P(DOB,"^",2),DGTEXT(4,0)="ELIG: "_$P(DGEC,"^",2)
|
|---|
| 22 | S DGC=5,DGTEXT(DGC,0)="",DGC=DGC+1
|
|---|
| 23 | Q
|
|---|
| 24 | WR I 'DGFL D INFO S DGTEXT(DGC,0)="This patient has the following Scheduled Admissions on file:" S DGFL=1
|
|---|
| 25 | S DGC=DGC+1,DGTEXT(DGC,0)=" DATE: "_Y_" "_$S($P(J,"^",10)="W":"WARD: "_$S($D(^DIC(42,+$P(J,"^",8),0)):$P(^(0),"^",1),1:""),$P(J,"^",10)="T":"FACILITY TREATING SPECIALTY: "_$S($D(^DIC(45.7,+$P(J,"^",9),0)):$P(^(0),"^",1),1:""),1:"") Q
|
|---|
| 26 | Q
|
|---|
| 27 | TEXT D INFO S:'DGFL DGTEXT(DGC,0)="This patient has the following waiting list entries:" S DGFL=1 Q
|
|---|
| 28 | CO S Y=$P(I,"^",2) X ^DD("DD") S DGTEXT(DGC,0)=" TO: "_DGG_" APPLIED: "_Y_" BEDSECTION: "_$P(I,"^",5) Q
|
|---|
