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

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1DGREG00 ;ALB/JDS-REGISTER A PATIENT, CONT. ; 1/3/05 6:18pm
2 ;;5.3;Registration;**86,108,113,91,149,642,624**;Aug 13, 1993
3W1 D NOW^%DTC S DGNOW=% K A,DGOPT
4 ;Print 10-10EZ
5 N FORM,EASMTIEN
6 S FORM=$$SEL1010^DG1010P("EZ")
7 S EASMTIEN=0
8 I FORM="EZ" D
9 . N EAPP,EAIP
10 . S (EAPP,EAIP)=0 F S EAPP=$O(^EAS(712,"AC",DFN,EAPP)) Q:'EAPP!EAIP D
11 . . I $$GET1^DIQ(712,EAPP,7.1)="" D
12 . . . N EAIX,EADT F EAIX="REV","PRT","SIG" Q:EAIP D
13 . . . . S EADT=0 F S EADT=$O(^EAS(712,EAIX,EADT)) Q:'EADT!EAIP I $D(^EAS(712,EAIX,EADT,EAPP)) S EAIP=1
14 . I EAIP D Q
15 . . N DIR
16 . . W !!,"No data have been found for the selected patient, or"
17 . . W !,"the patient may have an on-line 10-10EZ application"
18 . . W !,"in progress. The 10-10EZ form shall not be printed."
19 . . S DIR(0)="E" D ^DIR
20 . . S FORM=""
21 . S EASMTIEN=$$MTPRMPT^DG1010P(DFN,$G(DGMTI))
22 I FORM="EZ" S DB=1
23 ;
24W3 S PRF=0,RT=0 G QU:'$D(^DG(43,1,0))
25PRO I $$PROMPRN^DG1010PA("PRO") S PRF=1
26 I $$PROMPRN^DG1010PA("HS") S DGHS=1
27RT W !,"ROUTING SLIP" S %=1 D YN^DICN G Q:%=-1 I '% S DGPRINT=4 D HLP G RT
28 S RT=(%=1)
29QU I $G(DB) D
30 .S ZTRTN="EN^EASEZPDG",ZTDTH=DGNOW,ZTDESC="1010EZ - FROM REGISTRATION"
31 .S ZTSAVE("DA")=DFN,ZTSAVE("DFN")=DFN,ZTSAVE("DFN1")=DFN1
32 .S ZTSAVE("EASDFN")=DFN,ZTSAVE("EASFLAG")="",ZTSAVE("ZUSR")=DUZ
33 .S ZTSAVE("EASMTIEN")=EASMTIEN
34 .S ZTIO=DGIO(10) D ^%ZTLOAD
35QUPRF I $G(PRF) D
36 .S ZTRTN="DFN^PSOSD1",ZTDTH=DGNOW,ZTDESC="DRUG PROFILE - FROM REGISTRATION",ZTSAVE("PSOINST")=$G(PSOINST),ZTSAVE("PSONOPG")=$G(PSONOPG)
37 .S ZTSAVE("PSOPAR")=$G(PSOPAR),ZTSAVE("PSTYPE")=$G(PSTYPE),ZTSAVE("DFN")=DFN,ZTSAVE("DFN1")=DFN1,ZTIO=DGIO("PRF")
38 .D ^%ZTLOAD
39QUHS I $G(DGHS)&$G(GMTSTYP) D
40 .S ZTRTN="ENXQ^GMTSDVR",ZTDTH=DGNOW,ZTDESC="HEALTH SUMMARY - FROM REGISTRATION",ZTSAVE("GMTSTYP")=GMTSTYP,ZTSAVE("DFN")=DFN,ZTIO=DGIO(10)
41 .D ^%ZTLOAD
42 .K DGHS,GMTSTYP
43QURT I $G(RT) S ZTRTN="EN1^SDROUT1",ZTDTH=DGNOW,ZTDESC="ROUTING SLIP - FROM REGISTRATION",ZTSAVE("DFN")=DFN,ZTSAVE("DIV")=DIV,ZTSAVE("DT")=DT,ZTIO=DGIO("RT") D ^%ZTLOAD
44EMBOS ;W ! D EMBOS^DGQEMA
45 D EF^DG1010P
46Q K:'$D(DGASKDEV) DGIO
47Q1 ;
48 D EVNT
49 D CIRN
50 K %,%DT,A,B,ANS,APD,B,CURR,DA,DB,DE,DEF,DG1,DGCLPR,DGDAY,DGDFN,DGE,DGL,DGLL,DFMD,DGNEW,DGNOW,DGO,DIC,DIE,DINUM,DOW,DP,DR,I,I1,IOZBK,IOZFO,L,L1,L2,LL,LL1,LL2,MDCARD,PARA,PRF,RT,S,SC,SEEN
51 K VET,X,X1,X2,Y,Y1,ZTSK,D0,D1,DIV,DLAYGO,J,PGM,Z,EASMTIEN G A^DGREG:('$D(DGRPFEE)&('$D(RGMPI))) Q
52 ;
53DT G DT^DIQ:Y
54 Q
55SSD S DIV=$S('$D(^DG(40.8,+$P(A(0),"^",4),0)):" 1",1:" "_$P(A(0),"^",4))
56 Q
57HLP S DGPRINT=$P("10-10^10-10I^DRUG PROFILE^ROUTING SLIP","^",DGPRINT) W !!,"CHOOSE FROM",!?4,"YES - To include a copy of the ",DGPRINT," for this patient.",!?4,"NO - If you don't want to print a copy of the ",DGPRINT,"." K DGPRINT Q
58 ;
59EVNT ;list of external calls
60 N VAFHDATE
61 S VAFHDATE=+$G(^DPT(DFN,"DIS",DFN1,0))
62 K VAFHFLG D:+$$SEND^VAFHUTL() EN^VAFHLA04(DFN,VAFHDATE) ;fires Registration HL7 V1.5 message
63 K VAFHMRG
64 Q
65CIRN ;
66 Q:$P($$SEND^VAFHUTL(),"^",2)'>0
67 ;W !,"Doing CIRN Messaging..."
68 N DGZDATE,ERR
69 S DGZDATE=+$G(^DPT(DFN,"DIS",DFN1,0))
70 S ERR=$$EN^VAFCA04(DFN,DGZDATE) ; fires off HL7 V1.6 message
71 Q
Note: See TracBrowser for help on using the repository browser.