| 1 | DGRUGSA ;ALB/MLI/BOK - RUG-II BACK GROUND TRIGGER FOR SEMI-ANNUAL CENSUS ; 21 JAN 88
|
|---|
| 2 | ;;5.3;Registration;**7,54,89,104**;Aug 13, 1993
|
|---|
| 3 | S DGPGM="1^DGRUGSA",DGVAR="" D ZIS^DGUTQ G:POP QUIT U IO D 1 Q
|
|---|
| 4 | 1 S DGSEMI="",X="T",%DT="",U="^" D ^%DT S DGH=+Y
|
|---|
| 5 | S DGFL=0,DGY=$E(DGH,1,3),DGMD=$E(DGH,4,7) F I=0:1 S DGAD=$P($T(DATES+I),";;",2) Q:DGAD="QUIT" S X1=DGY_DGAD,X2=-31 D C^%DTC S DGB=X S X1=DGY_DGAD,X2=31 D C^%DTC S DGE=X I DGH>DGB,DGH<DGE S DGFL=1 Q
|
|---|
| 6 | I 'DGFL W !,"Semi-annual assessments can only be run for April 1 and September 30.",!,"Can not complete now." H 2 G QUIT
|
|---|
| 7 | S DGDT=DGY_""_DGAD
|
|---|
| 8 | F R=0:0 S R=$O(^DIC(42,R)) Q:R'>0 S W0=^(R,0),S=$P(^(0),U,3) I S]"","NHI"[S S DGWD(R)=$P(W0,U)_"^"_S
|
|---|
| 9 | F W0=0:0 S W0=$O(DGWD(W0)) Q:W0="" S DGW=$P(DGWD(W0),U),S=$P(DGWD(W0),U,2) F DFN=0:0 S DFN=$O(^DPT("CN",DGW,DFN)) Q:DFN'>0 S DGCA=^(DFN) I DGCA,$D(^DGPM(DGCA,0)),$P(^DGPM(DGCA,0),"^",2)=1 D CK S DGD=+^DGPM(DGCA,0) D FILE
|
|---|
| 10 | PRT K W,W1,I S W=0 F W1=0:0 S W=$O(^UTILITY($J,"PAI",W)) Q:W="" D HEAD S I=0 F I1=0:0 S I=$O(^UTILITY($J,"PAI",W,I)) Q:I="" S S=0 F S1=0:0 S S=$O(^UTILITY($J,"PAI",W,I,S)) Q:S'>0 W !,I,?30,$P(^(S),"^",2),?55 S Y=+^(S) D DT^DIQ
|
|---|
| 11 | QUIT W @IOF K %DT,A,DA,DFN,DGA1,DGAD,DGB,DGD,DGDT,DGE,DGFL,DGH,DGMD,DGN,DGCA,DGPGM,DGSEMI,DGSSN,DGT,DGY,DGVAR,DGW,DGWD,DGX,DIC,DIE,DLAYGO,DR,I,I1,J,R,S,S1,W,W0,W1,X,X1,X2,Y,^UTILITY($J) D CLOSE^DGUTQ Q
|
|---|
| 12 | CK Q:'$D(^DGPM("ATID2",DFN)) S (DGFL,I,J)=0 F I=0:0 Q:DGFL S I=$O(^DGPM("ATID2",DFN,I)) Q:'I F J=0:0 S J=$O(^DGPM("ATID2",DFN,I,J)) Q:'J I $D(^DGPM("ATID2",DFN,I,J)),$D(^DGPM(J,0)),($P(^(0),"^",14)=DGCA) S DGFL=1,DGCA=J Q
|
|---|
| 13 | Q
|
|---|
| 14 | HEAD W @IOF,!,?3,$P(^DIC(42,+W,0),U),?60,"DATE: " S Y=DGDT D DT^DIQ W !!,"PATIENT ASSESSMENT INSTRUMENTS HAVE BEEN CREATED FOR THE FOLLOWING PATIENTS ",!?5,"RESIDING ON INTERMEDIATE MEDICINE WARDS OR NURSING HOME CARE UNITS"
|
|---|
| 15 | W !?25,"DUE TO SEMI-ANNUAL CENSUS",!!,?5,"NAME",?33,"SSN",?46,"DATE OF ADMISSION/TRANSFER IN"
|
|---|
| 16 | Q
|
|---|
| 17 | FILE Q:$D(^DG(45.9,"AD",DFN,DGDT))
|
|---|
| 18 | N DGWARD
|
|---|
| 19 | S DLAYGO=45.9,DGSSN=$E($P(^DPT(DFN,0),U,9),1,9),DGN=$P(^(0),U),X=DFN
|
|---|
| 20 | S DIC="^DG(45.9,",DIC(0)="L" D FILE^DICN G:Y'>0 BUL
|
|---|
| 21 | S DA=+Y,DIE="^DG(45.9,",DGWARD=W0_";DIC(42,"
|
|---|
| 22 | S DR="6///2;2////"_DGDT_";3///"_DGSSN_";7///"_DGD_";70////^S X=DGWARD;9///"_S_";80///5" D ^DIE
|
|---|
| 23 | S ^UTILITY($J,"PAI",W0,DGN,DGSSN)=DGD_"^"_DGSSN Q
|
|---|
| 24 | BUL W !,"There was an attempt to set up a PAI record on ",$P(^DPT(DFN,0),U)," ",$P(^(0),U,9),!,"Please verify that this patient's data is accurate and create a PAI record." Q
|
|---|
| 25 | DATES ;;0401
|
|---|
| 26 | ;;1001
|
|---|
| 27 | ;;QUIT
|
|---|
| 28 | EN S IOP=$S($D(ION):ION,1:"") D ^%ZIS G 1
|
|---|
