source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCRPRT.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1DVBCRPRT ;ALB/GTS-557/THM-REPRINT C&P REPORT ; 5/17/91 10:28 AM
2 ;;2.7;AMIE;**31,42,119**;Apr 10, 1995;Build 10
3 ;
4 ; ** DVBCRPRT is called from DVBCRPON only **
5PHYS S PHYS=$S($D(^DVB(396.4,DA,0)):$P(^(0),U,7),1:"")
6 Q
7STEP2A ; ** Called from STEP2 only **
8 S EXMNM=$S($D(^DVB(396.6,$P(^DVB(396.4,DA,0),U,3),0)):$P(^(0),U,1),1:"Unknown exam"),EXHD="For "_EXMNM_" Exam" D HDR^DVBCRPR1
9 W "Examining provider: ",PHYS,!,"Examined on: " S Y=$P(^DVB(396.4,DA,0),U,6) X XDD W Y,! F LINE=1:1:80 W "="
10 W !!?2,"Examination results:",!! S EXSTAT=$P(^DVB(396.4,DA,0),U,4) I EXSTAT="X"!(EXSTAT="RX") W !!!!!?25,"This exam was CANCELLED by ",$S(EXSTAT="RX":"the RO.",1:"MAS."),!! Q
11 D STEP3
12 Q
13STEP2 ; ** An external entry point and called from GO2 **
14 F DA=0:0 S DA=$O(^DVB(396.4,"C",DA(1),DA)) Q:DA="" D GETRO Q:RO'=DUZ(2)&('$D(^XUSEC("DVBA C SUPERVISOR",DUZ))) S PG=0 D PHYS,STEP2A I $D(PRINT) D BOT^DVBCRPR1 K PRINT
15 D ^DVBCLABR Q
16 K DVBAON2
17 Q
18STEP3 ; ** Called from STEP2A only **
19 K ^UTILITY($J,"W") S DIWL=1,DIWR=80,DIWF="NW" S OLDA=DA,OLDA1=DA(1)
20 F LINE=0:0 S LINE=$O(^DVB(396.4,OLDA,"RES",LINE)) Q:LINE="" S X=^DVB(396.4,OLDA,"RES",LINE,0) D ^DIWP,STEP3A
21 D ^DIWW S PRINT=1 S DA=OLDA,DA(1)=OLDA1
22 Q
23STEP3A ; ** Called from STEP3 only **
24 I +$G(DVBGUI) D
25 .I $Y>(IOSL-9) D HDR^DVBCRPR1
26 I '+$G(DVBGUI) D
27 .I $Y>(IOSL-9) D UP^DVBCRPR1,NEXT,HDR^DVBCRPR1 W:$O(^DVB(396.4,OLDA,"RES",LINE))]""&&('+$G(DVBGUI)) !!,"Exam Results Continued",!!
28 Q
29GO ; ** An external entry point called from DVBCRPON **
30 U IO K ^TMP($J),DVBAON2 D HDA^DVBCRPR1 S (XCNT,XPRINT)=0
31 I '$D(^XUSEC("DVBA C SUPERVISOR",DUZ)) D
32 .F DA(1)=0:0 S DA(1)=$O(^DVB(396.3,"AF","C",DUZ(2),DA(1))) Q:DA(1)="" DO
33 ..I $D(^DVB(396.3,DA(1),0)) D GO1
34 ..I '$D(^DVB(396.3,DA(1),0)) D BADXRF^DVBCPRNT
35 I $D(^XUSEC("DVBA C SUPERVISOR",DUZ)) D
36 .F LOC=0:0 S LOC=$O(^DVB(396.3,"AF","C",LOC)) Q:LOC="" D
37 ..F DA(1)=0:0 S DA(1)=$O(^DVB(396.3,"AF","C",LOC,DA(1))) Q:DA(1)="" DO
38 ...I $D(^DVB(396.3,DA(1),0)) D GO1
39 ...I '$D(^DVB(396.3,DA(1),0)) D BADXRF^DVBCPRNT
40 I XPRINT=0 K XPRINT,XPG,XXLN W !!!!!?25,"Nothing to print",!! H 2 G KILL^DVBCUTIL
41 I XCNT>0,XPRINT=1 W !!,"Total requests to be printed: ",XCNT,!
42 K XCNT,XXLN,XPG,XPRINT D SETLAB^DVBCPRNT S (XCN,PNAM)=""
43 F DVBCN=0:0 S XCN=$O(^TMP($J,XCN)) Q:XCN="" F JJ=0:0 S PNAM=$O(^TMP($J,XCN,PNAM)) Q:PNAM="" D GO2
44 G EXIT
45GO2 F DA(1)=0:0 K PRINT S DA(1)=$O(^TMP($J,XCN,PNAM,DA(1))) Q:DA(1)="" S PRTDATE=$P(^DVB(396.3,DA(1),0),U,16) I PRTDATE[RUNDATE S DA=DA(1) D VARS^DVBCUTIL Q:(LOC'=RO)&('$D(^XUSEC("DVBA C SUPERVISOR",DUZ)))&('$D(AUTO)) D STEP2
46 Q
47GO1 S DFN=$P(^DVB(396.3,DA(1),0),U,1),PRTDATE=$P(^(0),U,16),PNAM=$P(^DPT(DFN,0),U,1),SSN=$P(^(0),U,9),CNUM=$S($D(^DPT(DFN,.31)):$P(^(.31),U,3),1:"Missing")
48 I RTYPE="D" Q:PRTDATE'[RUNDATE!(RUNDATE']"")
49 S XCN=$E(CNUM,$L(CNUM)-1,$L(CNUM)),XCN=+XCN
50 I PNAM]"" S ^TMP($J,XCN,PNAM,DA(1))="",XPRINT=1,XCNT=XCNT+1
51 D SSNSHRT^DVBCUTIL
52 W $E(PNAM,1,25),?28,DVBCSSNO,?43,CNUM,?55 S Y=$P(^DVB(396.3,DA(1),0),U,2) X XDD W Y,! D:$Y>(IOSL-16) HDA^DVBCRPR1
53 K PNAM,XCN,CNUM,DVBCSSNO
54 Q
55 ;
56EXIT K XDD,AUTO S LKILL=1 G KILL^DVBCUTIL ; ** GOTO will quit from this RTN
57 ;
58NEXT I '$D(DVBGUI) W !,"Continued on next page",!,"VA Form 2507"
59 Q
60 ;
61GETRO S RO=$P(^DVB(396.3,DA(1),0),U,3)
62 Q
Note: See TracBrowser for help on using the repository browser.