DGPTFTR3.m

DGPTFTR3 ;ALB/MJK - TRANSMISSION OF PTF/CENSUS ; 03/12/2004

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

 ;

BULL ;CREATE BULLETIN

 G BULLQ:DGTR<1

 S Y=$TR($$FMTE^XLFDT(DT,"5DF")," ","0")

 S ^UTILITY($J,"DGPTSTAT",1,0)="                           RUN DATE: "_Y,Y=$TR($$FMTE^XLFDT(DGSD,"5DF")," ","0")

 S %="        RELEASE DATE RANGE SELECTED: "_Y_" - " S Y=$TR($$FMTE^XLFDT($P(DGED,"."),"5DF")," ","0"),^UTILITY($J,"DGPTSTAT",2,0)=%_Y

 S ^UTILITY($J,"DGPTSTAT",4,0)="      TOTAL # OF "_$P(DGRTY0,U)_" RECORDS TRANSMITTED: "_$J(DGTR,6,0)

 F %=3,5,6 S ^UTILITY($J,"DGPTSTAT",%,0)=" "

 S ^UTILITY($J,"DGPTSTAT",7,0)="LOCAL MESSAGE ID#'S - COMPARE TO AUSTIN'S CONFIRMATION MESSAGES",DGUT=8,%=""

 F DGID=0:0 S DGID=$O(DGIDN(DGID)) Q:'DGID  S %=%_DGIDN(DGID)_"     " I $L(%)>70 S ^UTILITY($J,"DGPTSTAT",DGUT,0)=%,%="",DGUT=DGUT+1

 I $L(%) S ^UTILITY($J,"DGPTSTAT",DGUT,0)=%

 S XMSUB=$P(DGRTY0,U)_" TRANSMISSION STATISTICS SUMMARY("_$S(VATNAME["125":125,1:80)_" COLS)",XMDUZ=.5,XMTEXT="^UTILITY($J,""DGPTSTAT"",",XMY(DUZ)=""

 D ^XMD

BULLQ K DGD,J,DGCNT,VAT,VATERR,VATNAME,DGID,DGIDN,DGSDI,DGTR,DGUT,XMZ,DGERR,PTF,T1,T2,Y,DFN,DGJ,DGK,XMSUB,XMTEXT,XMY,XMDUZ,% Q

 ;

SCAN ; -- see if all released recs are xmited

 F DGD=DGSD-.01:0 S DGD=$O(^DGP(45.83,DGD)) Q:'DGD!(DGD>DGED)  D SCAN1

 Q

SCAN1 ; -- scan rec log

 S DGYES=1

 F DGI=0:0 S DGI=$O(^DGP(45.83,DGD,"P",DGI)) Q:'DGI  I $D(^(DGI,0)),'$P(^(0),U,2) S DGYES=0 Q

 I DGYES S DIE="^DGP(45.83,",DA=DGD,DR="1///TODAY" D ^DIE

 K DGYES,DIE,DR,DGI

 Q

 ;

CEN ; -- test to see if PTF rec can be sent

 S Y=1

 F DGCI=0:0 S DGCI=$O(^DGPT("ACENSUS",J,DGCI)) Q:'DGCI  I $D(^DGPT(DGCI,0)),$P(^(0),U,13)=DGCN S Y=0 Q

 I 'Y S Y=$P(DGCN0,U,3) X ^DD("DD") W !?5,*7,"[PTF #",J," for ",$P(^DPT(+^DGPT(J,0),0),U)," cannot be transmitted until ",Y,"." S Y=+DGCN0 X ^DD("DD") W !?6,"This admission is a ",Y," Census admission.]" S Y=0

 K DGCI Q

 ;

OPEN ;

 S DGPTIFN=J,DGPTFX=""

 S DIK="^DGP(45.83,DGD,""P"",",DA(1)=DGD,DA=DGPTIFN D ^DIK

 I '$O(^DGP(45.83,DGD,"P",0)) S DIK="^DGP(45.83,",DA=DGD D ^DIK

 D KDGP^DGPTFDEL

 I DGRTY=2,$D(^DGPT(+DGPTIFN,0)) S DGPTFX=+$P(^(0),U,12) I $D(^DGPT(DGPTFX,0)),$D(^DGP(45.84,DGPTFX,0)) S DGJ=DGPTIFN,DGPTIFN=DGPTFX D KDGP^DGPTFDEL S DGPTIFN=DGJ K DGJ

 K XMY

 I 'DGPTFX S DGJ(1,0)="PTF Record "_DGPTIFN_" of "_$P(^DPT(+^DGPT(DGPTIFN,0),0),U)_" re-opened."

 I DGPTFX S DGJ(1,0)="PTF Record #"_DGPTFX_" of "_$P(^DPT(+^DGPT(DGPTFX,0),0),U)_" re-opened for census." ;,DGJ(2,0)=" ",DGJ(3,0)="CENSUS Record #"_DGPTIFN_" has been deleted."

 S XMTEXT="DGJ(",XMDUZ=.5,XMSUB=$P(DGRTY0,U)_" RECORD REOPENED",XMY(DUZ)="" D ^XMD

 S DGCNT=DGSTCNT("P",DGPTIFN) K DGSTCNT("P",DGPTIFN) F K=DGCNT-.01:0 S K=$O(^XMB(3.9,DGXMZ,2,K)) Q:K'>0  K ^(K,0)

 I DGRTY=2 D KDGPT^DGPTFDEL

 W !,$P(DGRTY0,U)," RECORD RE-OPENED"

 K DIK,DA,XMY,XMTEXT,XMDUZ,XMSUB,DGPTIFN,DGPTFX Q

 ;

DGPTFTR3  ;ALB/MJK - TRANSMISSION OF PTF/CENSUS ; 03/12/2004

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

 +2       ;

BULL      ;CREATE BULLETIN

 +1        IF DGTR<1

               GOTO BULLQ

 +2        SET Y=$TRANSLATE($$FMTE^XLFDT(DT,"5DF")," ","0")

 +3        SET ^UTILITY($JOB,"DGPTSTAT",1,0)="                           RUN DATE: "_Y

           SET Y=$TRANSLATE($$FMTE^XLFDT(DGSD,"5DF")," ","0")

 +4        SET %="        RELEASE DATE RANGE SELECTED: "_Y_" - "

           SET Y=$TRANSLATE($$FMTE^XLFDT($PIECE(DGED,"."),"5DF")," ","0")

           SET ^UTILITY($JOB,"DGPTSTAT",2,0)=%_Y

 +5        SET ^UTILITY($JOB,"DGPTSTAT",4,0)="      TOTAL # OF "_$PIECE(DGRTY0,U)_" RECORDS TRANSMITTED: "_$JUSTIFY(DGTR,6,0)

 +6        FOR %=3,5,6

               SET ^UTILITY($JOB,"DGPTSTAT",%,0)=" "

 +7        SET ^UTILITY($JOB,"DGPTSTAT",7,0)="LOCAL MESSAGE ID#'S - COMPARE TO AUSTIN'S CONFIRMATION MESSAGES"

           SET DGUT=8

           SET %=""

 +8        FOR DGID=0:0

               SET DGID=$ORDER(DGIDN(DGID))

               IF 'DGID

                   QUIT 

               SET %=%_DGIDN(DGID)_"     "

               IF $LENGTH(%)>70

                   SET ^UTILITY($JOB,"DGPTSTAT",DGUT,0)=%

                   SET %=""

                   SET DGUT=DGUT+1

 +9        IF $LENGTH(%)

               SET ^UTILITY($JOB,"DGPTSTAT",DGUT,0)=%

 +10       SET XMSUB=$PIECE(DGRTY0,U)_" TRANSMISSION STATISTICS SUMMARY("_$SELECT(VATNAME["125":125,1:80)_" COLS)"

           SET XMDUZ=.5

           SET XMTEXT="^UTILITY($J,""DGPTSTAT"","

           SET XMY(DUZ)=""

 +11       DO ^XMD

BULLQ      KILL DGD,J,DGCNT,VAT,VATERR,VATNAME,DGID,DGIDN,DGSDI,DGTR,DGUT,XMZ,DGERR,PTF,T1,T2,Y,DFN,DGJ,DGK,XMSUB,XMTEXT,XMY,XMDUZ,%

           QUIT 

 +1       ;

SCAN      ; -- see if all released recs are xmited

 +1        FOR DGD=DGSD-.01:0

               SET DGD=$ORDER(^DGP(45.83,DGD))

               IF 'DGD!(DGD>DGED)

                   QUIT 

               DO SCAN1

 +2        QUIT 

SCAN1     ; -- scan rec log

 +1        SET DGYES=1

 +2        FOR DGI=0:0

               SET DGI=$ORDER(^DGP(45.83,DGD,"P",DGI))

               IF 'DGI

                   QUIT 

               IF $DATA(^(DGI,0))

                   IF '$PIECE(^(0),U,2)

                       SET DGYES=0

                       QUIT 

 +3        IF DGYES

               SET DIE="^DGP(45.83,"

               SET DA=DGD

               SET DR="1///TODAY"

               DO ^DIE

 +4        KILL DGYES,DIE,DR,DGI

 +5        QUIT 

 +6       ;

CEN       ; -- test to see if PTF rec can be sent

 +1        SET Y=1

 +2        FOR DGCI=0:0

               SET DGCI=$ORDER(^DGPT("ACENSUS",J,DGCI))

               IF 'DGCI

                   QUIT 

               IF $DATA(^DGPT(DGCI,0))

                   IF $PIECE(^(0),U,13)=DGCN

                       SET Y=0

                       QUIT 

 +3        IF 'Y

               SET Y=$PIECE(DGCN0,U,3)

               XECUTE ^DD("DD")

               WRITE !?5,*7,"[PTF #",J," for ",$PIECE(^DPT(+^DGPT(J,0),0),U)," cannot be transmitted until ",Y,"."

               SET Y=+DGCN0

               XECUTE ^DD("DD")

               WRITE !?6,"This admission is a ",Y," Census admission.]"

               SET Y=0

 +4        KILL DGCI

           QUIT 

 +5       ;

OPEN      ;

 +1        SET DGPTIFN=J

           SET DGPTFX=""

 +2        SET DIK="^DGP(45.83,DGD,""P"","

           SET DA(1)=DGD

           SET DA=DGPTIFN

           DO ^DIK

 +3        IF '$ORDER(^DGP(45.83,DGD,"P",0))

               SET DIK="^DGP(45.83,"

               SET DA=DGD

               DO ^DIK

 +4        DO KDGP^DGPTFDEL

 +5        IF DGRTY=2

               IF $DATA(^DGPT(+DGPTIFN,0))

                   SET DGPTFX=+$PIECE(^(0),U,12)

                   IF $DATA(^DGPT(DGPTFX,0))

                       IF $DATA(^DGP(45.84,DGPTFX,0))

                           SET DGJ=DGPTIFN

                           SET DGPTIFN=DGPTFX

                           DO KDGP^DGPTFDEL

                           SET DGPTIFN=DGJ

                           KILL DGJ

 +6        KILL XMY

 +7        IF 'DGPTFX

               SET DGJ(1,0)="PTF Record "_DGPTIFN_" of "_$PIECE(^DPT(+^DGPT(DGPTIFN,0),0),U)_" re-opened."

 +8       ;,DGJ(2,0)=" ",DGJ(3,0)="CENSUS Record #"_DGPTIFN_" has been deleted."

           IF DGPTFX

               SET DGJ(1,0)="PTF Record #"_DGPTFX_" of "_$PIECE(^DPT(+^DGPT(DGPTFX,0),0),U)_" re-opened for census."

 +9        SET XMTEXT="DGJ("

           SET XMDUZ=.5

           SET XMSUB=$PIECE(DGRTY0,U)_" RECORD REOPENED"

           SET XMY(DUZ)=""

           DO ^XMD

 +10       SET DGCNT=DGSTCNT("P",DGPTIFN)

           KILL DGSTCNT("P",DGPTIFN)

           FOR K=DGCNT-.01:0

               SET K=$ORDER(^XMB(3.9,DGXMZ,2,K))

               IF K'>0

                   QUIT 

               KILL ^(K,0)

 +11       IF DGRTY=2

               DO KDGPT^DGPTFDEL

 +12       WRITE !,$PIECE(DGRTY0,U)," RECORD RE-OPENED"

 +13       KILL DIK,DA,XMY,XMTEXT,XMDUZ,XMSUB,DGPTIFN,DGPTFX

           QUIT 

 +14      ;