DGRUGV ;ALB/BOK - RUG/PAI TRANSMISSION ; 12 MAY 87 07:25
;;5.3;Registration;**89,159**;Aug 13, 1993
S VATNAME="RUG-II" D ^VATRAN G QUIT:VATERR
W !,*7,"This option will send the RUG/PAI data to the Austin DPC."
A S %=2 W !,"Are you sure you want to continue" D YN^DICN I '% W !,"REPLY (Y)ES OR (N)O" G A
D START:%=1
QUIT K ^UTILITY($J),%,%DT,D,DA,DGBC,DGCON,DGCNT,DGD,DGED,DGFLG,DGLCO,DGI,DGP,DGPG,DGPGM,DGPT,DGROW,DGS,DGSD,DGVAR,DGXX,DGSDI,VAT,VATERR,VATNAME,DIE,DR,I,J,K,L,POP,S,X,XMDUZ,XMSUB,XMTEXT,XMY,Y Q
START K ^UTILITY($J) D LO^DGUTL R !,"Survey purpose: (A)dmission/transfer & CNH or (S)emi-annual? ",X:DTIME G QUIT:X[U,HELP:"AS"'[X S DGP=$S(X="A":1,X="S":2,1:0) G QUIT:'DGP
DATE D CLOSEOUT^DGRUG S DGCNT=0,%DT("A")="ASSESSMENT START DATE: ",%DT="AEP" D ^%DT K %DT("A") G QUIT:Y<0,CLOUT:Y<DGLCO,FUT:Y>DT S DGSD=Y-.1 S %DT(0)=DGSD,%DT("A")="END DATE: " D ^%DT K %DT("A") G QUIT:Y<0,FUT:Y>DT S DGED=Y
DEV S %ZIS("A")="Device to print errors on: ",DGVAR="DGP^DGSD^DGED^VAT#^DUZ",DGPGM="EN^DGRUGV" D ZIS^DGUTQ G:POP QUIT
EN D LO^DGUTL S (DGFLG,DGXX)="",(DGCNT,DGROW)=0,DGPG=1,$P(DGXX," ",106)=""
;If transmission date after cutover date (4/1/98) send 4 digit year.
N DGRUGYTK
S DGRUGYTK=$S(DT>2980401:1,1:0)
F I=DGSD:0 S I=$O(^DG(45.9,"AP",DGP,I)) Q:I'>0!(I>DGED) F J=0:0 S J=$O(^DG(45.9,"AP",DGP,I,J)) Q:J'>0 I $D(^DG(45.9,J,0)) S DGI=^(0),DGS=$S($D(^DG(45.9,J,"C")):+^("C"),1:"") D ERR:DGS'=2 I DGS=2 D SET:$D(DGFLG)
I DGP=1 S DGP=3 D
.F I=DGSD:0 S I=$O(^DG(45.9,"AP",DGP,I)) Q:I'>0!(I>DGED) F J=0:0 S J=$O(^DG(45.9,"AP",DGP,I,J)) Q:J'>0 I $D(^DG(45.9,J,0)) S DGI=^(0),DGS=$S($D(^DG(45.9,J,"C")):+^("C"),1:"") D ERR:DGS'=2 I DGS=2 D SET:$D(DGFLG)
I $D(^UTILITY($J,"DGRUG")) F DGBC=1:1:DGPG D ROUTER S XMSUB="RUG-II TRANSMISSION, MESSAGE # "_DGBC,XMTEXT="^UTILITY("_$J_",""DGRUG"","_DGBC_",1," D ^XMD
G PERR
ROUTER F DGSDI=0:0 S DGSDI=$O(VAT(DGSDI)) Q:DGSDI'>0 S XMY(VAT(DGSDI))=""
S XMDUZ=.5,XMY(DUZ)="" Q
SET S X="" F K=3:1:5 S L=$P(DGI,U,K) G ERR:L']"" S X=X_L
S D=$P(DGI,U,2) D DAT S X=X_$P(DGI,U,6),D=$P(DGI,U,7) D DAT F K=8:1:21 S L=$P(DGI,U,K) G ERR:L']""&(DGP'=3)&(K'=9) S:(DGP=3)&(K=9)&(DGRUGYTK=1) L=" " S X=X_L
S X=X_" " F K=23:1:28 S L=$P(DGI,U,K) G ERR:L']"" S X=X_L
S X=X_" " F K=32:1:35 S L=$P(DGI,U,K) G ERR:L']"" S X=X_L
S X=X_" " F K=40:1:57 S L=$P(DGI,U,K) G ERR:L']"" S X=X_L
F K=63:1:67 S L=$P(DGI,U,K) G ERR:L']"" S X=X_$S($L(L)=4:L,$L(L)=3:"0"_L,$L(L)=2:"00"_L,1:"000"_L)
F K=58:1:62 S L=$P(DGI,U,K) G ERR:L']"" S X=X_L
F K=1:1:$S(DGRUGYTK=1:21,1:25) S X=X_" "
S:DGROW+1>VAT("F") DGPG=DGPG+1,DGROW=0 S DGROW=DGROW+1,^UTILITY($J,"DGRUG",DGPG,1,DGROW,0)=$E(X_DGXX,1,130),DGCNT=DGCNT+1
S DA=J,DR="80///4;83///"_DT,DIE="^DG(45.9," D ^DIE Q
ERR S:DGS=4 ^UTILITY($J,"TRANS",J)=DGI S:DGS'=4 ^UTILITY($J,"ERR",J)=DGI Q
PERR S X=132 X ^%ZOSF("RM")
W @IOF,!?95,"Transmission Date: " S Y=DT D DT^DIQ W:($D(^UTILITY($J,"ERR"))!$D(^("TRANS"))) !!?5,"NAME",?40,"SSN",?55,"ASSESSMENT DATE",?80,"STATUS",! S I="",$P(I,"*",132)="" W I
I $D(^UTILITY($J,"ERR")) W !!,"ERRORS",! F J=0:0 S J=$O(^UTILITY($J,"ERR",J)) Q:J'>0 S K=^(J) W !,$P(^DPT(+K,0),U,1),?38,$P(K,U,3),?55,$$FMTE^XLFDT($P(K,U,2),"5DZ"),?82 D STAT W S
I $D(^UTILITY($J,"TRANS")) W !!,"RECORDS ALREADY TRANSMITTED",! F J=0:0 S J=$O(^UTILITY($J,"TRANS",J)) Q:J'>0 S K=^(J) W !,$P(^DPT(+K,0),U,1),?38,$P(K,U,3),?55,$$FMTE^XLFDT($P(K,U,2),"5DZ"),?82 D STAT W S
W !!!,I,!!!,"NUMBER OF RECORDS SENT TO AUSTIN: ",DGCNT,!,"DATE RANGE SENT: " S Y=DGSD+.1 D DT^DIQ W " - " S Y=DGED D DT^DIQ W !,"ASSESSMENT PURPOSE: ",$S(DGP=2:"SEMI-ANNUAL",+DGP'=2:"ADMISSION/TRANSFER & CNH",1:""),@IOF
CLOSE D QUIT,CLOSE^DGUTQ
Q
STAT S S=$S($D(^DG(45.9,J,"C")):+^("C"),1:""),S=$S(S=1:"COMPLETED",S=2:"CLOSED BUT MISSING DATA",S=3:"RELEASED",S=4:"TRANSMITTED",S=0:"OPEN",5:"INCOMPLETE",1:"NO STATUS") Q
DAT I DGRUGYTK=1 S D=$E(D,4,5)_$E(D,6,7)_($E(D,1,3)+1700),X=X_D Q
S D=$E(D,4,5)_$E(D,6,7)_$E(D,2,3),X=X_D
Q
HELP W !!,"Depending on type of survey being transmitted enter",!?5,"A - Admission/Transfer PAI Survey",!?5,"S - Semi-annual PAI survey",! G START
CLOUT W !!,*7,"Start date must be within current closeout cycle.",!,"Date must not be before " S Y=DGLCO D DT^DIQ W ".",!! G DATE
FUT W !!,*7,"Can not transmit for future dates",!! G DATE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUGV 4281 printed Dec 13, 2024@02:58:36 Page 2
DGRUGV ;ALB/BOK - RUG/PAI TRANSMISSION ; 12 MAY 87 07:25
+1 ;;5.3;Registration;**89,159**;Aug 13, 1993
+2 SET VATNAME="RUG-II"
DO ^VATRAN
if VATERR
GOTO QUIT
+3 WRITE !,*7,"This option will send the RUG/PAI data to the Austin DPC."
A SET %=2
WRITE !,"Are you sure you want to continue"
DO YN^DICN
IF '%
WRITE !,"REPLY (Y)ES OR (N)O"
GOTO A
+1 if %=1
DO START
QUIT KILL ^UTILITY($JOB),%,%DT,D,DA,DGBC,DGCON,DGCNT,DGD,DGED,DGFLG,DGLCO,DGI,DGP,DGPG,DGPGM,DGPT,DGROW,DGS,DGSD,DGVAR,DGXX,DGSDI,VAT,VATERR,VATNAME,DIE,DR,I,J,K,L,POP,S,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
QUIT
START KILL ^UTILITY($JOB)
DO LO^DGUTL
READ !,"Survey purpose: (A)dmission/transfer & CNH or (S)emi-annual? ",X:DTIME
if X[U
GOTO QUIT
if "AS"'[X
GOTO HELP
SET DGP=$SELECT(X="A":1,X="S":2,1:0)
if 'DGP
GOTO QUIT
DATE DO CLOSEOUT^DGRUG
SET DGCNT=0
SET %DT("A")="ASSESSMENT START DATE: "
SET %DT="AEP"
DO ^%DT
KILL %DT("A")
if Y<0
GOTO QUIT
if Y<DGLCO
GOTO CLOUT
if Y>DT
GOTO FUT
SET DGSD=Y-.1
SET %DT(0)=DGSD
SET %DT("A")="END DATE: "
DO ^%DT
KILL %DT("A")
if Y<0
GOTO QUIT
if Y>DT
GOTO FUT
SET DGED=Y
DEV SET %ZIS("A")="Device to print errors on: "
SET DGVAR="DGP^DGSD^DGED^VAT#^DUZ"
SET DGPGM="EN^DGRUGV"
DO ZIS^DGUTQ
if POP
GOTO QUIT
EN DO LO^DGUTL
SET (DGFLG,DGXX)=""
SET (DGCNT,DGROW)=0
SET DGPG=1
SET $PIECE(DGXX," ",106)=""
+1 ;If transmission date after cutover date (4/1/98) send 4 digit year.
+2 NEW DGRUGYTK
+3 SET DGRUGYTK=$SELECT(DT>2980401:1,1:0)
+4 FOR I=DGSD:0
SET I=$ORDER(^DG(45.9,"AP",DGP,I))
if I'>0!(I>DGED)
QUIT
FOR J=0:0
SET J=$ORDER(^DG(45.9,"AP",DGP,I,J))
if J'>0
QUIT
IF $DATA(^DG(45.9,J,0))
SET DGI=^(0)
SET DGS=$SELECT($DATA(^DG(45.9,J,"C")):+^("C"),1:"")
if DGS'=2
DO ERR
IF DGS=2
if $DATA(DGFLG)
DO SET
+5 IF DGP=1
SET DGP=3
Begin DoDot:1
+6 FOR I=DGSD:0
SET I=$ORDER(^DG(45.9,"AP",DGP,I))
if I'>0!(I>DGED)
QUIT
FOR J=0:0
SET J=$ORDER(^DG(45.9,"AP",DGP,I,J))
if J'>0
QUIT
IF $DATA(^DG(45.9,J,0))
SET DGI=^(0)
SET DGS=$SELECT($DATA(^DG(45.9,J,"C")):+^("C"),1:"")
if DGS'=2
DO ERR
IF DGS=2
if $DATA(DGFLG)
DO SET
End DoDot:1
+7 IF $DATA(^UTILITY($JOB,"DGRUG"))
FOR DGBC=1:1:DGPG
DO ROUTER
SET XMSUB="RUG-II TRANSMISSION, MESSAGE # "_DGBC
SET XMTEXT="^UTILITY("_$JOB_",""DGRUG"","_DGBC_",1,"
DO ^XMD
+8 GOTO PERR
ROUTER FOR DGSDI=0:0
SET DGSDI=$ORDER(VAT(DGSDI))
if DGSDI'>0
QUIT
SET XMY(VAT(DGSDI))=""
+1 SET XMDUZ=.5
SET XMY(DUZ)=""
QUIT
SET SET X=""
FOR K=3:1:5
SET L=$PIECE(DGI,U,K)
if L']""
GOTO ERR
SET X=X_L
+1 SET D=$PIECE(DGI,U,2)
DO DAT
SET X=X_$PIECE(DGI,U,6)
SET D=$PIECE(DGI,U,7)
DO DAT
FOR K=8:1:21
SET L=$PIECE(DGI,U,K)
if L']""&(DGP'=3)&(K'=9)
GOTO ERR
if (DGP=3)&(K=9)&(DGRUGYTK=1)
SET L=" "
SET X=X_L
+2 SET X=X_" "
FOR K=23:1:28
SET L=$PIECE(DGI,U,K)
if L']""
GOTO ERR
SET X=X_L
+3 SET X=X_" "
FOR K=32:1:35
SET L=$PIECE(DGI,U,K)
if L']""
GOTO ERR
SET X=X_L
+4 SET X=X_" "
FOR K=40:1:57
SET L=$PIECE(DGI,U,K)
if L']""
GOTO ERR
SET X=X_L
+5 FOR K=63:1:67
SET L=$PIECE(DGI,U,K)
if L']""
GOTO ERR
SET X=X_$SELECT($LENGTH(L)=4:L,$LENGTH(L)=3:"0"_L,$LENGTH(L)=2:"00"_L,1:"000"_L)
+6 FOR K=58:1:62
SET L=$PIECE(DGI,U,K)
if L']""
GOTO ERR
SET X=X_L
+7 FOR K=1:1:$SELECT(DGRUGYTK=1:21,1:25)
SET X=X_" "
+8 if DGROW+1>VAT("F")
SET DGPG=DGPG+1
SET DGROW=0
SET DGROW=DGROW+1
SET ^UTILITY($JOB,"DGRUG",DGPG,1,DGROW,0)=$EXTRACT(X_DGXX,1,130)
SET DGCNT=DGCNT+1
+9 SET DA=J
SET DR="80///4;83///"_DT
SET DIE="^DG(45.9,"
DO ^DIE
QUIT
ERR if DGS=4
SET ^UTILITY($JOB,"TRANS",J)=DGI
if DGS'=4
SET ^UTILITY($JOB,"ERR",J)=DGI
QUIT
PERR SET X=132
XECUTE ^%ZOSF("RM")
+1 WRITE @IOF,!?95,"Transmission Date: "
SET Y=DT
DO DT^DIQ
if ($DATA(^UTILITY($JOB,"ERR"))!$DATA(^("TRANS")))
WRITE !!?5,"NAME",?40,"SSN",?55,"ASSESSMENT DATE",?80,"STATUS",!
SET I=""
SET $PIECE(I,"*",132)=""
WRITE I
+2 IF $DATA(^UTILITY($JOB,"ERR"))
WRITE !!,"ERRORS",!
FOR J=0:0
SET J=$ORDER(^UTILITY($JOB,"ERR",J))
if J'>0
QUIT
SET K=^(J)
WRITE !,$PIECE(^DPT(+K,0),U,1),?38,$PIECE(K,U,3),?55,$$FMTE^XLFDT($PIECE(K,U,2),"5DZ"),?82
DO STAT
WRITE S
+3 IF $DATA(^UTILITY($JOB,"TRANS"))
WRITE !!,"RECORDS ALREADY TRANSMITTED",!
FOR J=0:0
SET J=$ORDER(^UTILITY($JOB,"TRANS",J))
if J'>0
QUIT
SET K=^(J)
WRITE !,$PIECE(^DPT(+K,0),U,1),?38,$PIECE(K,U,3),?55,$$FMTE^XLFDT($PIECE(K,U,2),"5DZ"),?82
DO STAT
WRITE S
+4 WRITE !!!,I,!!!,"NUMBER OF RECORDS SENT TO AUSTIN: ",DGCNT,!,"DATE RANGE SENT: "
SET Y=DGSD+.1
DO DT^DIQ
WRITE " - "
SET Y=DGED
DO DT^DIQ
WRITE !,"ASSESSMENT PURPOSE: ",$SELECT(DGP=2:"SEMI-ANNUAL",+DGP'=2:"ADMISSION/TRANSFER & CNH",1:""),@IOF
CLOSE DO QUIT
DO CLOSE^DGUTQ
+1 QUIT
STAT SET S=$SELECT($DATA(^DG(45.9,J,"C")):+^("C"),1:"")
SET S=$SELECT(S=1:"COMPLETED",S=2:"CLOSED BUT MISSING DATA",S=3:"RELEASED",S=4:"TRANSMITTED",S=0:"OPEN",5:"INCOMPLETE",1:"NO STATUS")
QUIT
DAT IF DGRUGYTK=1
SET D=$EXTRACT(D,4,5)_$EXTRACT(D,6,7)_($EXTRACT(D,1,3)+1700)
SET X=X_D
QUIT
+1 SET D=$EXTRACT(D,4,5)_$EXTRACT(D,6,7)_$EXTRACT(D,2,3)
SET X=X_D
+2 QUIT
HELP WRITE !!,"Depending on type of survey being transmitted enter",!?5,"A - Admission/Transfer PAI Survey",!?5,"S - Semi-annual PAI survey",!
GOTO START
CLOUT WRITE !!,*7,"Start date must be within current closeout cycle.",!,"Date must not be before "
SET Y=DGLCO
DO DT^DIQ
WRITE ".",!!
GOTO DATE
FUT WRITE !!,*7,"Can not transmit for future dates",!!
GOTO DATE
