source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTFTR3.m@ 1651

Last change on this file since 1651 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1DGPTFTR3 ;ALB/MJK - TRANSMISSION OF PTF/CENSUS ; 03/12/2004
2 ;;5.3;Registration;**568**;Aug 13, 1993
3 ;
4BULL ;CREATE BULLETIN
5 G BULLQ:DGTR<1
6 S Y=$TR($$FMTE^XLFDT(DT,"5DF")," ","0")
7 S ^UTILITY($J,"DGPTSTAT",1,0)=" RUN DATE: "_Y,Y=$TR($$FMTE^XLFDT(DGSD,"5DF")," ","0")
8 S %=" RELEASE DATE RANGE SELECTED: "_Y_" - " S Y=$TR($$FMTE^XLFDT($P(DGED,"."),"5DF")," ","0"),^UTILITY($J,"DGPTSTAT",2,0)=%_Y
9 S ^UTILITY($J,"DGPTSTAT",4,0)=" TOTAL # OF "_$P(DGRTY0,U)_" RECORDS TRANSMITTED: "_$J(DGTR,6,0)
10 F %=3,5,6 S ^UTILITY($J,"DGPTSTAT",%,0)=" "
11 S ^UTILITY($J,"DGPTSTAT",7,0)="LOCAL MESSAGE ID#'S - COMPARE TO AUSTIN'S CONFIRMATION MESSAGES",DGUT=8,%=""
12 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
13 I $L(%) S ^UTILITY($J,"DGPTSTAT",DGUT,0)=%
14 S XMSUB=$P(DGRTY0,U)_" TRANSMISSION STATISTICS SUMMARY("_$S(VATNAME["125":125,1:80)_" COLS)",XMDUZ=.5,XMTEXT="^UTILITY($J,""DGPTSTAT"",",XMY(DUZ)=""
15 D ^XMD
16BULLQ 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
17 ;
18SCAN ; -- see if all released recs are xmited
19 F DGD=DGSD-.01:0 S DGD=$O(^DGP(45.83,DGD)) Q:'DGD!(DGD>DGED) D SCAN1
20 Q
21SCAN1 ; -- scan rec log
22 S DGYES=1
23 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
24 I DGYES S DIE="^DGP(45.83,",DA=DGD,DR="1///TODAY" D ^DIE
25 K DGYES,DIE,DR,DGI
26 Q
27 ;
28CEN ; -- test to see if PTF rec can be sent
29 S Y=1
30 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
31 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
32 K DGCI Q
33 ;
34OPEN ;
35 S DGPTIFN=J,DGPTFX=""
36 S DIK="^DGP(45.83,DGD,""P"",",DA(1)=DGD,DA=DGPTIFN D ^DIK
37 I '$O(^DGP(45.83,DGD,"P",0)) S DIK="^DGP(45.83,",DA=DGD D ^DIK
38 D KDGP^DGPTFDEL
39 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
40 K XMY
41 I 'DGPTFX S DGJ(1,0)="PTF Record "_DGPTIFN_" of "_$P(^DPT(+^DGPT(DGPTIFN,0),0),U)_" re-opened."
42 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."
43 S XMTEXT="DGJ(",XMDUZ=.5,XMSUB=$P(DGRTY0,U)_" RECORD REOPENED",XMY(DUZ)="" D ^XMD
44 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)
45 I DGRTY=2 D KDGPT^DGPTFDEL
46 W !,$P(DGRTY0,U)," RECORD RE-OPENED"
47 K DIK,DA,XMY,XMTEXT,XMDUZ,XMSUB,DGPTIFN,DGPTFX Q
48 ;
Note: See TracBrowser for help on using the repository browser.