Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGRUGSA

DGRUGSA.m

Go to the documentation of this file.
DGRUGSA ;ALB/MLI/BOK - RUG-II BACK GROUND TRIGGER FOR SEMI-ANNUAL CENSUS ; 21 JAN 88
 ;;5.3;Registration;**7,54,89,104,1015**;Aug 13, 1993;Build 21
 S DGPGM="1^DGRUGSA",DGVAR="" D ZIS^DGUTQ G:POP QUIT U IO D 1 Q
1 S DGSEMI="",X="T",%DT="",U="^" D ^%DT S DGH=+Y
 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
 I 'DGFL W !,"Semi-annual assessments can only be run for April 1 and September 30.",!,"Can not complete now." H 2 G QUIT
 S DGDT=DGY_""_DGAD
 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
 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
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
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
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
 Q
 W !?25,"DUE TO SEMI-ANNUAL CENSUS",!!,?5,"NAME",?33,"SSN",?46,"DATE OF ADMISSION/TRANSFER IN"
 Q
FILE Q:$D(^DG(45.9,"AD",DFN,DGDT))
 N DGWARD
 S DLAYGO=45.9,DGSSN=$E($P(^DPT(DFN,0),U,9),1,9),DGN=$P(^(0),U),X=DFN
 S DIC="^DG(45.9,",DIC(0)="L" D FILE^DICN G:Y'>0 BUL
 S DA=+Y,DIE="^DG(45.9,",DGWARD=W0_";DIC(42,"
 S DR="6///2;2////"_DGDT_";3///"_DGSSN_";7///"_DGD_";70////^S X=DGWARD;9///"_S_";80///5" D ^DIE
 S ^UTILITY($J,"PAI",W0,DGN,DGSSN)=DGD_"^"_DGSSN Q
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
DATES ;;0401
 ;;1001
 ;;QUIT
EN S IOP=$S($D(ION):ION,1:"") D ^%ZIS G 1