DGRUGV16.m

DGRUGV16 ;ALB/BOK - RUG/PAI TRANSMISSION ; 12 MAY 87 07:25

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

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

DGRUGV16  ;ALB/BOK - RUG/PAI TRANSMISSION ; 12 MAY 87 07:25

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

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