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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGREG00 3142 printed Apr 09, 2024@21:53:56 Page 2
DGREG00 ;ALB/JDS-REGISTER A PATIENT, CONT. ; 1/3/05 6:18pm
+1 ;;5.3;Registration;**86,108,113,91,149,642,624**;Aug 13, 1993
W1 DO NOW^%DTC
SET DGNOW=%
KILL A,DGOPT
+1 ;Print 10-10EZ
+2 NEW FORM,EASMTIEN
+3 SET FORM=$$SEL1010^DG1010P("EZ")
+4 SET EASMTIEN=0
+5 IF FORM="EZ"
Begin DoDot:1
+6 NEW EAPP,EAIP
+7 SET (EAPP,EAIP)=0
FOR
SET EAPP=$ORDER(^EAS(712,"AC",DFN,EAPP))
if 'EAPP!EAIP
QUIT
Begin DoDot:2
+8 IF $$GET1^DIQ(712,EAPP,7.1)=""
Begin DoDot:3
+9 NEW EAIX,EADT
FOR EAIX="REV","PRT","SIG"
if EAIP
QUIT
Begin DoDot:4
+10 SET EADT=0
FOR
SET EADT=$ORDER(^EAS(712,EAIX,EADT))
if 'EADT!EAIP
QUIT
IF $DATA(^EAS(712,EAIX,EADT,EAPP))
SET EAIP=1
End DoDot:4
End DoDot:3
End DoDot:2
+11 IF EAIP
Begin DoDot:2
+12 NEW DIR
+13 WRITE !!,"No data have been found for the selected patient, or"
+14 WRITE !,"the patient may have an on-line 10-10EZ application"
+15 WRITE !,"in progress. The 10-10EZ form shall not be printed."
+16 SET DIR(0)="E"
DO ^DIR
+17 SET FORM=""
End DoDot:2
QUIT
+18 SET EASMTIEN=$$MTPRMPT^DG1010P(DFN,$GET(DGMTI))
End DoDot:1
+19 IF FORM="EZ"
SET DB=1
+20 ;
W3 SET PRF=0
SET RT=0
if '$DATA(^DG(43,1,0))
GOTO QU
PRO IF $$PROMPRN^DG1010PA("PRO")
SET PRF=1
+1 IF $$PROMPRN^DG1010PA("HS")
SET DGHS=1
RT WRITE !,"ROUTING SLIP"
SET %=1
DO YN^DICN
if %=-1
GOTO Q
IF '%
SET DGPRINT=4
DO HLP
GOTO RT
+1 SET RT=(%=1)
QU IF $GET(DB)
Begin DoDot:1
+1 SET ZTRTN="EN^EASEZPDG"
SET ZTDTH=DGNOW
SET ZTDESC="1010EZ - FROM REGISTRATION"
+2 SET ZTSAVE("DA")=DFN
SET ZTSAVE("DFN")=DFN
SET ZTSAVE("DFN1")=DFN1
+3 SET ZTSAVE("EASDFN")=DFN
SET ZTSAVE("EASFLAG")=""
SET ZTSAVE("ZUSR")=DUZ
+4 SET ZTSAVE("EASMTIEN")=EASMTIEN
+5 SET ZTIO=DGIO(10)
DO ^%ZTLOAD
End DoDot:1
QUPRF IF $GET(PRF)
Begin DoDot:1
+1 SET ZTRTN="DFN^PSOSD1"
SET ZTDTH=DGNOW
SET ZTDESC="DRUG PROFILE - FROM REGISTRATION"
SET ZTSAVE("PSOINST")=$GET(PSOINST)
SET ZTSAVE("PSONOPG")=$GET(PSONOPG)
+2 SET ZTSAVE("PSOPAR")=$GET(PSOPAR)
SET ZTSAVE("PSTYPE")=$GET(PSTYPE)
SET ZTSAVE("DFN")=DFN
SET ZTSAVE("DFN1")=DFN1
SET ZTIO=DGIO("PRF")
+3 DO ^%ZTLOAD
End DoDot:1
QUHS IF $GET(DGHS)&$GET(GMTSTYP)
Begin DoDot:1
+1 SET ZTRTN="ENXQ^GMTSDVR"
SET ZTDTH=DGNOW
SET ZTDESC="HEALTH SUMMARY - FROM REGISTRATION"
SET ZTSAVE("GMTSTYP")=GMTSTYP
SET ZTSAVE("DFN")=DFN
SET ZTIO=DGIO(10)
+2 DO ^%ZTLOAD
+3 KILL DGHS,GMTSTYP
End DoDot:1
QURT IF $GET(RT)
SET ZTRTN="EN1^SDROUT1"
SET ZTDTH=DGNOW
SET ZTDESC="ROUTING SLIP - FROM REGISTRATION"
SET ZTSAVE("DFN")=DFN
SET ZTSAVE("DIV")=DIV
SET ZTSAVE("DT")=DT
SET ZTIO=DGIO("RT")
DO ^%ZTLOAD
EMBOS ;W ! D EMBOS^DGQEMA
+1 DO EF^DG1010P
Q if '$DATA(DGASKDEV)
KILL DGIO
Q1 ;
+1 DO EVNT
+2 DO CIRN
+3 KILL %,%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
+4 KILL VET,X,X1,X2,Y,Y1,ZTSK,D0,D1,DIV,DLAYGO,J,PGM,Z,EASMTIEN
if ('$DATA(DGRPFEE)&('$DATA(RGMPI)))
GOTO A^DGREG
QUIT
+5 ;
DT if Y
GOTO DT^DIQ
+1 QUIT
SSD SET DIV=$SELECT('$DATA(^DG(40.8,+$PIECE(A(0),"^",4),0)):" 1",1:" "_$PIECE(A(0),"^",4))
+1 QUIT
HLP SET DGPRINT=$PIECE("10-10^10-10I^DRUG PROFILE^ROUTING SLIP","^",DGPRINT)
WRITE !!,"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,"."
KILL DGPRINT
QUIT
+1 ;
EVNT ;list of external calls
+1 NEW VAFHDATE
+2 SET VAFHDATE=+$GET(^DPT(DFN,"DIS",DFN1,0))
+3 ;fires Registration HL7 V1.5 message
KILL VAFHFLG
if +$$SEND^VAFHUTL()
DO EN^VAFHLA04(DFN,VAFHDATE)
+4 KILL VAFHMRG
+5 QUIT
CIRN ;
+1 if $PIECE($$SEND^VAFHUTL(),"^",2)'>0
QUIT
+2 ;W !,"Doing CIRN Messaging..."
+3 NEW DGZDATE,ERR
+4 SET DGZDATE=+$GET(^DPT(DFN,"DIS",DFN1,0))
+5 ; fires off HL7 V1.6 message
SET ERR=$$EN^VAFCA04(DFN,DGZDATE)
+6 QUIT
