Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGREG00

DGREG00.m

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