DGPTFTR3 ;ALB/MJK,HIOFO/FT - TRANSMISSION OF PTF/CENSUS ; 7/6/15 8:38am
;;5.3;Registration;**568,884**;Aug 13, 1993;Build 31
;
; XMB(3.9) - #10113
; XLFDT - #10103
; XMD - #10070
;
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",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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPTFTR3 2896 printed Oct 16, 2024@18:53:12 Page 2
DGPTFTR3 ;ALB/MJK,HIOFO/FT - TRANSMISSION OF PTF/CENSUS ; 7/6/15 8:38am
+1 ;;5.3;Registration;**568,884**;Aug 13, 1993;Build 31
+2 ;
+3 ; XMB(3.9) - #10113
+4 ; XLFDT - #10103
+5 ; XMD - #10070
+6 ;
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"
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 ;
