72 lines
3.0 KiB
Mathematica
72 lines
3.0 KiB
Mathematica
DGREG00 ;ALB/JDS-REGISTER A PATIENT, CONT. ; 1/3/05 6:18pm
|
|
;;5.3;Registration;**86,108,113,91,149,642,624**;Aug 13, 1993
|
|
W1 D NOW^%DTC S DGNOW=% K A,DGOPT
|
|
;Print 10-10EZ
|
|
N FORM,EASMTIEN
|
|
S FORM=$$SEL1010^DG1010P("EZ")
|
|
S EASMTIEN=0
|
|
I FORM="EZ" D
|
|
. N EAPP,EAIP
|
|
. S (EAPP,EAIP)=0 F S EAPP=$O(^EAS(712,"AC",DFN,EAPP)) Q:'EAPP!EAIP D
|
|
. . I $$GET1^DIQ(712,EAPP,7.1)="" D
|
|
. . . N EAIX,EADT F EAIX="REV","PRT","SIG" Q:EAIP D
|
|
. . . . S EADT=0 F S EADT=$O(^EAS(712,EAIX,EADT)) Q:'EADT!EAIP I $D(^EAS(712,EAIX,EADT,EAPP)) S EAIP=1
|
|
. I EAIP D Q
|
|
. . N DIR
|
|
. . W !!,"No data have been found for the selected patient, or"
|
|
. . W !,"the patient may have an on-line 10-10EZ application"
|
|
. . W !,"in progress. The 10-10EZ form shall not be printed."
|
|
. . S DIR(0)="E" D ^DIR
|
|
. . S FORM=""
|
|
. S EASMTIEN=$$MTPRMPT^DG1010P(DFN,$G(DGMTI))
|
|
I FORM="EZ" S DB=1
|
|
;
|
|
W3 S PRF=0,RT=0 G QU:'$D(^DG(43,1,0))
|
|
PRO I $$PROMPRN^DG1010PA("PRO") S PRF=1
|
|
I $$PROMPRN^DG1010PA("HS") S DGHS=1
|
|
RT W !,"ROUTING SLIP" S %=1 D YN^DICN G Q:%=-1 I '% S DGPRINT=4 D HLP G RT
|
|
S RT=(%=1)
|
|
QU I $G(DB) D
|
|
.S ZTRTN="EN^EASEZPDG",ZTDTH=DGNOW,ZTDESC="1010EZ - FROM REGISTRATION"
|
|
.S ZTSAVE("DA")=DFN,ZTSAVE("DFN")=DFN,ZTSAVE("DFN1")=DFN1
|
|
.S ZTSAVE("EASDFN")=DFN,ZTSAVE("EASFLAG")="",ZTSAVE("ZUSR")=DUZ
|
|
.S ZTSAVE("EASMTIEN")=EASMTIEN
|
|
.S ZTIO=DGIO(10) D ^%ZTLOAD
|
|
QUPRF I $G(PRF) D
|
|
.S ZTRTN="DFN^PSOSD1",ZTDTH=DGNOW,ZTDESC="DRUG PROFILE - FROM REGISTRATION",ZTSAVE("PSOINST")=$G(PSOINST),ZTSAVE("PSONOPG")=$G(PSONOPG)
|
|
.S ZTSAVE("PSOPAR")=$G(PSOPAR),ZTSAVE("PSTYPE")=$G(PSTYPE),ZTSAVE("DFN")=DFN,ZTSAVE("DFN1")=DFN1,ZTIO=DGIO("PRF")
|
|
.D ^%ZTLOAD
|
|
QUHS I $G(DGHS)&$G(GMTSTYP) D
|
|
.S ZTRTN="ENXQ^GMTSDVR",ZTDTH=DGNOW,ZTDESC="HEALTH SUMMARY - FROM REGISTRATION",ZTSAVE("GMTSTYP")=GMTSTYP,ZTSAVE("DFN")=DFN,ZTIO=DGIO(10)
|
|
.D ^%ZTLOAD
|
|
.K DGHS,GMTSTYP
|
|
QURT 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
|
|
EMBOS ;W ! D EMBOS^DGQEMA
|
|
D EF^DG1010P
|
|
Q K:'$D(DGASKDEV) DGIO
|
|
Q1 ;
|
|
D EVNT
|
|
D CIRN
|
|
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
|
|
K VET,X,X1,X2,Y,Y1,ZTSK,D0,D1,DIV,DLAYGO,J,PGM,Z,EASMTIEN G A^DGREG:('$D(DGRPFEE)&('$D(RGMPI))) Q
|
|
;
|
|
DT G DT^DIQ:Y
|
|
Q
|
|
SSD S DIV=$S('$D(^DG(40.8,+$P(A(0),"^",4),0)):" 1",1:" "_$P(A(0),"^",4))
|
|
Q
|
|
HLP 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
|
|
;
|
|
EVNT ;list of external calls
|
|
N VAFHDATE
|
|
S VAFHDATE=+$G(^DPT(DFN,"DIS",DFN1,0))
|
|
K VAFHFLG D:+$$SEND^VAFHUTL() EN^VAFHLA04(DFN,VAFHDATE) ;fires Registration HL7 V1.5 message
|
|
K VAFHMRG
|
|
Q
|
|
CIRN ;
|
|
Q:$P($$SEND^VAFHUTL(),"^",2)'>0
|
|
;W !,"Doing CIRN Messaging..."
|
|
N DGZDATE,ERR
|
|
S DGZDATE=+$G(^DPT(DFN,"DIS",DFN1,0))
|
|
S ERR=$$EN^VAFCA04(DFN,DGZDATE) ; fires off HL7 V1.6 message
|
|
Q
|