- 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 Feb 19, 2025@00:20:52 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