source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCREQP.m@ 701

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1DVBCREQP ;ALB/GTS-557/THM-PRINT NEW REQUESTS ; 6/27/91 9:36 AM
2 ;;2.7;AMIE;;Apr 10, 1995
3 S DVBAMAN="" G EN
4 ;
5CK1 F JI=BDTRQ-.1:0 S JI=$O(^DVB(396.3,XD,JI)) Q:JI="" F DA(1)=0:0 S DA(1)=$O(^DVB(396.3,XD,JI,DA(1))) Q:DA(1)="" S DVBXD=$S($D(^DVB(396.3,DA(1),1)):$P(^(1),U,4),1:"") I DVBXD=XDIV S FIND=1
6 Q
7 ;
8PRINT K OUT S STAT=$P(^DVB(396.3,DA(1),0),U,18) ;I STAT["X" S OUT=1 Q
9 S DVBCDIV=$S($D(^DVB(396.3,DA(1),1)):$P(^(1),U,4),1:"") Q:DVBCDIV'=XDIV S DA=DA(1) D VARS^DVBCUTIL,^DVBCREQ1 S:CNUM="" CNUM=99999999 S:SSN="" SSN=999999999 S:PNAM="" PNAM="Missing vet name"
10 S DA=DA(1),DIE="^DVB(396.3,",DR="17////P" I STAT="N"!(STAT="NT") D ^DIE
11SET S DA=DA(1),DR="4///NOW",(DIC,DIE)="^DVB(396.3,"
12 I $P(^DVB(396.3,DA,0),U,5)="" D ^DIE
13 I '$D(ONE) S ^TMP($J,DVBCTYPE,PNAM,SSN,CNUM)="" ;for last sheet
14 S (PNAM,SSN,CNUM,ADR1,ADR2,ADR3,CITY,STATE,ZIP,HOMPHON,BUSPHON,OTHDIS)="",PRINT=1
15 Q
16 ;
17EN K PRINT S Y=DT X ^DD("DD") S DVBCDT(0)=Y D HOME^%ZIS S FF=IOF W @FF,"Manual New C&P Request Printing",!!!
18 ;
19ASK K ONE W !,"Do you want just one request" S %=2 D YN^DICN G:$D(DTOUT) EXIT I $D(%Y),%Y["?" W !,"Enter Y for only one Vet or N for all Vets.",! G ASK
20 G:%Y=U EXIT I %=1 G ONEREQ
21 W ! D DIV I $D(OUT) K OUT G EXIT
22 W ! S %DT(0)=-DT,%DT="AET",%DT("A")="Enter BEGINNING date of request: " D ^%DT G:Y<0 EXIT S BDTRQ=Y,%DT="AET",%DT("A")=" and ENDING date of request: " D ^%DT G:Y<0 EN S EDTRQ=Y+.2359
23 I EDTRQ<BDTRQ W !!,*7,"Ending date is earlier than starting date!",!! H 2 G EN
24 ;
25DEVICE K %DT W !! S %ZIS="AEQ",%ZIS("A")="Output device: " D ^%ZIS K %ZIS G:POP EXIT
26 I $D(IO("Q")) S ZTRTN=$S($D(ONE):"PRINT^DVBCREQP",1:"GO^DVBCREQP"),ZTIO=ION,ZTDESC="New C&P request printing" F I="ONE","BDTRQ*","EDTRQ*","DA*","Y","XDIV","DIVNM","DVBCDT(0)","DVBCMAN" S ZTSAVE(I)=""
27 I $D(IO("Q")) D ^%ZTLOAD G:'$D(ZTSK) EXIT W !!,"Request queued",!! G EXIT
28 I $D(ONE) U IO D PRINT K DA G EXIT
29 ;
30GO D STM^DVBCUTL4
31 U IO S X="New C&P Requests -- "_DIVNM
32 W:(IOST?1"C-".E) @IOF
33 W !!!!!!!!!!!!!!! F I=1:1:10 W ?5,X,!!
34 K ^TMP($J),X S DVBCTYPE="NEW"
35 F JI=BDTRQ_".0001":0 S JI=$O(^DVB(396.3,"C",JI)) Q:JI=""!(JI>EDTRQ) F DA(1)=0:0 S DA(1)=$O(^DVB(396.3,"C",JI,DA(1))) Q:DA(1)="" K OUT D PRINT
36 K OUT I '$D(PRINT) W @IOF,!!!,"There were no new 2507 requests for " S Y=BDTRQ X ^DD("DD") W Y," to " S Y=$E(EDTRQ,1,7) X ^DD("DD") W Y,!,"for division ",DIVNM,!!
37MODS K FIND S XD="AC" D CK1 I '$D(FIND) G ADDS
38 K PRINT,FIND S X="C&P Request Modifications -- "_DIVNM W @IOF,!!!!!!!!!!!!!!! F I=1:1:10 W ?5,X,!!
39 K X S DVBCTYPE="MODIFIED"
40 F JI=BDTRQ_".0001":0 S JI=$O(^DVB(396.3,"AC",JI)) Q:JI=""!(JI>EDTRQ) F DA(1)=0:0 S DA(1)=$O(^DVB(396.3,"AC",JI,DA(1))) Q:DA(1)="" K OUT D PRINT
41 I '$D(PRINT) W @IOF,!!!,"No modified requests to report.",!!
42 ;
43ADDS K FIND S XD="AD" D CK1 I '$D(FIND) G RECAP
44 K PRINT,FIND S X="C&P Exams Added -- "_DIVNM W @IOF,!!!!!!!!!!!!!!! F I=1:1:10 W ?5,X,!!
45 K X S DVBCTYPE="ADDITIONAL"
46 F JI=BDTRQ_".0001":0 S JI=$O(^DVB(396.3,"AD",JI)) Q:JI=""!(JI>EDTRQ) F DA(1)=0:0 S DA(1)=$O(^DVB(396.3,"AD",JI,DA(1))) Q:DA(1)="" K OUT D PRINT
47 I '$D(PRINT) W @IOF,!!!,"No added exams to report.",!!
48RECAP D ^DVBCREQ3 ;recap sheet
49 ;
50EXIT S XRTN=$T(+0)
51 D SPM^DVBCUTL4
52 I $D(DVBCMAN)&($D(ZTQUEUED)) D KILL^%ZTLOAD
53 K DVBCMAN,DIVNM,XDIV,DVBXD G KILL^DVBCUTIL
54 ;
55 ;
56ONEREQ W !! S DIC="^DVB(396.3,",DIC(0)="AEQM",DIC("W")="W !?10,""Date of request: "" S:$D(Y) OLDY=Y S Y=$P(^(0),U,2) X ^DD(""DD"") W Y S:$D(OLDY) Y=OLDY",DIC("A")="Enter VETERAN NAME: " D ^DIC G:X=""!(X=U) EXIT
57 S JI=$P(Y,U,2),DA(1)=+Y D DIV I $D(OUT) G EXIT
58 S ONE=1 G DEVICE
59 ;
60TASK D ^DVBCREQ2 Q
61 ;
62DIV W !! K OUT S DIC("A")="Enter MED CENTER DIVISION: ",DIC(0)="AEQM",DIC="^DG(40.8," D ^DIC I X=""!(X=U) S OUT=1 Q
63 I +Y<0 W *7," ???" G DIV
64 S XDIV=+Y,DIVNM=$S($D(^DG(40.8,XDIV,0)):$P(^(0),U,1),1:"Unknown Division") Q
Note: See TracBrowser for help on using the repository browser.