DGRUGV16 ;ALB/BOK - RUG/PAI TRANSMISSION ; 12 MAY 87 07:25
;;5.3;Registration;;Aug 13, 1993
QUIT K ^UTILITY($J),%,%DT,D,DA,DGBC,DGPGM,DGCNT,DGED,DGFLG,DGI,DGP,DGPG,DGROW,DGS,DGSD,DGVAR,DGXX,DGSDI,VAT,VATERR,VATNAME,DIE,DR,I,J,K,L,POP,S,X,XMDUZ,XMSUB,XMTEXT,XMY,Y Q
DEV S %ZIS("A")="Device to print errors on: ",DGVAR="DGP^DGSD^DGED^VAT#^DUZ",DGPGM="EN^DGRUGV16" D ZIS^DGUTQ G:POP QUIT
EN D LO^DGUTL S (DGFLG,DGXX)="",(DGCNT,DGROW)=0,DGPG=1,$P(DGXX," ",81)=""
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:20 S L=$P(DGI,U,K) G ERR: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
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,80),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,$E($P(K,U,2),4,5)_"/"_$E($P(K,U,2),6,7)_"/"_$E($P(K,U,2),2,3),?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,$E($P(K,U,2),4,5)_"/"_$E($P(K,U,2),6,7)_"/"_$E($P(K,U,2),2,3),?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=1:"ADMISSION/TRANSFER",1:"SEMI-ANNUAL"),@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 S D=$E(D,4,5)_$E(D,6,7)_$E(D,2,3),X=X_D Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUGV16 2675 printed Oct 16, 2024@18:59:10 Page 2
DGRUGV16 ;ALB/BOK - RUG/PAI TRANSMISSION ; 12 MAY 87 07:25
+1 ;;5.3;Registration;;Aug 13, 1993
QUIT KILL ^UTILITY($JOB),%,%DT,D,DA,DGBC,DGPGM,DGCNT,DGED,DGFLG,DGI,DGP,DGPG,DGROW,DGS,DGSD,DGVAR,DGXX,DGSDI,VAT,VATERR,VATNAME,DIE,DR,I,J,K,L,POP,S,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
QUIT
DEV SET %ZIS("A")="Device to print errors on: "
SET DGVAR="DGP^DGSD^DGED^VAT#^DUZ"
SET DGPGM="EN^DGRUGV16"
DO ZIS^DGUTQ
if POP
GOTO QUIT
EN DO LO^DGUTL
SET (DGFLG,DGXX)=""
SET (DGCNT,DGROW)=0
SET DGPG=1
SET $PIECE(DGXX," ",81)=""
+1 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
+2 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
+3 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:20
SET L=$PIECE(DGI,U,K)
if L']""
GOTO ERR
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 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,80)
SET DGCNT=DGCNT+1
+6 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,$EXTRACT($PIECE(K,U,2),4,5)_"/"_$EXTRACT($PIECE(K,U,2),6,7)_"/"_$EXTRACT($PIECE(K,U,2),2,3),?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,$EXTRACT($PIECE(K,U,2),4,5)_"/"_$EXTRACT($PIECE(K,U,2),6,7)_"/"_$EXTRACT($PIECE(K,U,2),2,3),?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=1:"ADMISSION/TRANSFER",1:"SEMI-ANNUAL"),@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 SET D=$EXTRACT(D,4,5)_$EXTRACT(D,6,7)_$EXTRACT(D,2,3)
SET X=X_D
QUIT
