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

DGRPTI.m

Go to the documentation of this file. 
  1. DGRPTI ;ALB/RMO - 10-10T Registration - Interview;21 NOV 1996 8:43 am ; 8/28/00 9:42am
  1.  ;;5.3;Registration;**108,147,175,343**;08/13/93
  1.  ;
  1. EN ;Entry point for DGRPT INTERVIEW protocol
  1.  ; Input  -- DFN      Patient IEN
  1.  ; Output -- VALMBCK  R   =Refresh screen
  1.  N DGRPTOUT
  1.  S VALMBCK=""
  1.  D FULL^VALM1
  1.  D INT(DFN,"",.DGRPTOUT),PAUSE^VALM1:'DGRPTOUT
  1.  D BLD^DGRPTL S VALMBCK="R"
  1.  Q
  1.  ;
  1. INT(DFN,DGNEWPF,DGRPTOUT) ;Interview for 10-10T registration
  1.  ; Input  -- DFN      Patient IEN
  1.  ;           DGNEWPF  New patient added flag
  1.  ;                    1   =New patient added
  1.  ;                    Null=Existing patient
  1.  ; Output -- DGRPTOUT Quit flag
  1.  ;                     0  =No
  1.  ;                    -1  =User entered up-arrow
  1.  ;                    -2  =Timeout
  1.  ;                    -3  =Unable to lock record
  1.  N DG1010TF,DGASKDEV,DGDIV,DGIO
  1.  ;
  1.  D BEGINREG^DGREG(DFN)
  1.  ;
  1.  ;Set the 10-10T registration flag and the quit flag
  1.  S DG1010TF=1,DGRPTOUT=0
  1.  ;
  1.  ;Set up registration parameters
  1.  D SETPAR^DGRPTU(.DGDIV,.DGIO,.DGASKDEV,.DGRPTOUT)
  1.  I DGRPTOUT<0,$$ASKEXT(.DGRPTOUT) G INTQ
  1.  ;
  1.  D CKUPLOAD^DGENUPL3(DFN)
  1.  ;
  1.  ;Edit patient data for 10-10T
  1.  D PAT(DFN,DGNEWPF,.DGRPTOUT)
  1.  I DGRPTOUT<0,$$ASKEXT(.DGRPTOUT) G INTQ
  1.  ;
  1.  ;
  1.  D CKUPLOAD^DGENUPL3(DFN)
  1.  ;
  1.  ;Edit marital information for 10-10T
  1.  D MAR(DFN,.DGRPTOUT)
  1.  I DGRPTOUT<0,$$ASKEXT(.DGRPTOUT) G INTQ
  1.  ;
  1.  ;
  1.  D CKUPLOAD^DGENUPL3(DFN)
  1.  ;
  1.  ;Edit income data for 10-10T
  1.  D INC(DFN,.DGRPTOUT)
  1.  I DGRPTOUT<0,$$ASKEXT(.DGRPTOUT) G INTQ
  1.  ;
  1.  ;
  1.  D CKUPLOAD^DGENUPL3(DFN)
  1.  ;
  1.  ;Edit insurance data for 10-10T
  1.  D INS(DFN,.DGRPTOUT)
  1.  I DGRPTOUT<0,$$ASKEXT(.DGRPTOUT) G INTQ
  1.  ;
  1.  ;Ask if user would like to do a HINQ inquiry
  1.  D HINQ(DFN,.DGRPTOUT)
  1.  I DGRPTOUT<0,$$ASKEXT(.DGRPTOUT) G INTQ
  1.  ;
  1.  ;Invoke consistency checker
  1.  D CONCK(DFN,.DGRPTOUT)
  1.  I DGRPTOUT<0,$$ASKEXT(.DGRPTOUT) G INTQ
  1.  ;
  1.  ;Check for open disposition
  1.  I $D(^DPT("ADA",1,DFN)) D  G INTQ ;exit if open disposition
  1.  . W !!,*7,">>> Patient cannot be registered while there is still an open disposition."
  1.  ;
  1.  ;Register patient
  1.  I $$ASKREG D
  1.  . D EN1010T^DGREG(DFN,DGNEWPF,DGDIV,.DGIO,$G(DGASKDEV),DG1010TF)
  1.  ELSE  D
  1.  . ;Print 10-10T
  1.  . I $$ASKPRT D
  1.  . . I $D(DGIO(10)) D
  1.  . . . D QUE^DGRPTP(DFN,,.DGIO) ;queue 10-10T print
  1.  . . ELSE  D
  1.  . . . D ENDEV^DGRPTP(DFN) ;ask device then print 10-10T
  1.  ;
  1. INTQ D ENDREG^DGREG(DFN)
  1.  Q
  1.  ;
  1. PAT(DFN,DGNEWPF,DGRPTOUT) ;Edit patient data for 10-10T
  1.  ; Input  -- DFN      Patient IEN
  1.  ;           DGNEWPF  New patient added flag
  1.  ; Output -- DGRPTOUT Quit flag
  1.  N DA,DIE,DTOUT,DR,IOINHI,IOINORM,X
  1.  S X="IOINHI;IOINORM" D ENDR^%ZISS
  1.  W !,"---",IOINHI,"Patient: Eligibility, Demographic",IOINORM,"---"
  1.  W !,IOINHI,"   Emergency Contact and Military Service",IOINORM
  1.  ;Check elig prior to permitting edit of name, dob and ssn
  1.  I '$G(DGNEWPF),$$ELGCHK^DGRPTU(DFN) D ID(DFN,.DGRPTOUT) G PATQ:DGRPTOUT<0
  1.  S DA=DFN,DIE="^DPT(",DR="[DGRPT 10-10T REGISTRATION]"
  1.  L +^DPT(DA):0 I $T D
  1.  . D ^DIE L -^DPT(DA)
  1.  . ;DGFIN is used to determine whether or not the user entered
  1.  . ;an up-arrow when calling DIE
  1.  . S DGRPTOUT=$S($D(DTOUT):-2,'$D(DGFIN):-1,1:0)
  1.  ELSE  D
  1.  . W !,"Another user is editing, try later ..."
  1.  . S DGRPTOUT=-3
  1.  K DGFIN
  1.  I $D(DGPHMULT) D EDITPH1^DGRPLE()
  1.  K DGPHMULT
  1. PATQ Q
  1.  ;
  1. ID(DFN,DGRPTOUT) ;Edit patient name, dob and ssn
  1.  ; Input  -- DFN      Patient IEN
  1.  ; Output -- DGRPTOUT Quit flag
  1.  N DA,DIE,DTOUT,DR
  1.  S DA=DFN,DIE="^DPT(",DR="K DGFIN;.01;.03;.09;@98;S DGFIN="""""
  1.  L +^DPT(DA):0 I $T D
  1.  . D ^DIE L -^DPT(DA)
  1.  . S DGRPTOUT=$S($D(DTOUT):-2,'$D(DGFIN):-1,1:0)
  1.  ELSE  D
  1.  . W !,"Another user is editing, try later ..."
  1.  . S DGRPTOUT=-3
  1.  K DGFIN
  1.  Q
  1.  ;
  1. MAR(DFN,DGRPTOUT) ;Edit marital information for 10-10T
  1.  ; Input  -- DFN      Patient IEN
  1.  ; Output -- DGRPTOUT Quit flag
  1.  N DGDEP,DGERR,DGFL,DGINI,DGIRI,DGISDT,DGPRI,DGREL,DGSPFL,DTOUT,IOINHI,IOINORM,X
  1.  ;Set income screening date to last year
  1.  S DGISDT=$$LYR^DGMTSCU1(DT)
  1.  ;
  1.  ;Make sure patient is in the Patient Relation file (#408.12)
  1.  D NEW^DGRPEIS1
  1.  S DGRPTOUT=DGFL
  1.  ;
  1.  ;Set active dependent Patient Relation array DGREL for SPOUSE calls
  1.  D GETREL^DGMTU11(DFN,"VS",DGISDT) G MARQ:'$G(DGREL("V"))
  1.  ;
  1.  S X="IOINHI;IOINORM" D ENDR^%ZISS
  1.  W !!,"---",IOINHI,"Marital",IOINORM,"---"
  1.  ;
  1.  ;Check if patient was married last calendar year
  1.  D SPOUSE^DGRPEIS2
  1.  I $G(DTOUT) S DGRPTOUT=-2
  1.  I DGRPTOUT<0,$$ASKEXT(.DGRPTOUT) G MARQ
  1.  ;
  1.  ;If patient was married last calendar year ask spouse information
  1.  I $G(DGSPFL) D SPOUSE(DFN,.DGREL,.DGRPTOUT)
  1. MARQ Q
  1.  ;
  1. SPOUSE(DFN,DGREL,DGRPTOUT) ;Edit spouse data for 10-10T
  1.  ; Input  -- DFN      Patient IEN
  1.  ;           DGREL    Active dependent array
  1.  ; Output -- DGRPTOUT Quit flag
  1.  N DGFL,DGIPI,DGPRI,IOINHI,IOINORM,X
  1.  S X="IOINHI;IOINORM" D ENDR^%ZISS
  1.  W !!,"---",IOINHI,"Spouse",IOINORM,"---"
  1.  I '$G(DGREL("S")) D
  1.  . ;Add demographic data for spouse
  1.  . D ADD^DGRPEIS(DFN,"S")
  1.  ELSE  D
  1.  . ;Edit demographic data for spouse
  1.  . D EDIT^DGRPEIS(DGREL("S"),"S")
  1.  S DGRPTOUT=DGFL
  1.  Q
  1.  ;
  1. INC(DFN,DGRPTOUT) ;Edit income data for 10-10T
  1.  ; Input  -- DFN      Patient IEN
  1.  ; Output -- DGRPTOUT Quit flag
  1.  N DA,DGDEP,DGFL,DGINC,DIE,DR,DTOUT,IOINHI,IOINORM,X
  1.  ;Get patient's Individual Annual Income file (#408.21) IEN - DGINC("V")
  1.  D ALL^DGMTU21(DFN,"V",DT,"I") G INCQ:'$G(DGINC("V"))
  1.  ;
  1.  S X="IOINHI;IOINORM" D ENDR^%ZISS
  1.  W !!,"---",IOINHI,"Income",IOINORM,"---"
  1.  ;
  1.  ;Edit patient's Last Year's Estimated "Household" Taxable Income
  1.  S DA=DGINC("V"),DIE="^DGMT(408.21,",DR="K DGFIN;.21T;@98;S DGFIN="""""
  1.  L +^DGMT(408.21,DA):0 I $T D
  1.  . D ^DIE L -^DGMT(408.21,DA)
  1.  . S DGRPTOUT=$S($D(DTOUT):-2,'$D(DGFIN):-1,1:0)
  1.  ELSE  D
  1.  . W !,"Another user is editing, try later..."
  1.  . S DGRPTOUT=-3
  1.  K DGFIN
  1. INCQ Q
  1.  ;
  1. INS(DFN,DGRPTOUT) ;Edit insurance data for 10-10T
  1.  ; Input  -- DFN      Patient IEN
  1.  ; Output -- DGRPTOUT Quit flag
  1.  N DTOUT,DUOUT,IBCOV,IOINHI,IOINORM,X
  1.  S X="IOINHI;IOINORM" D ENDR^%ZISS
  1.  W !!,"---",IOINHI,"Insurance",IOINORM,"---"
  1.  ;
  1.  ;Update insurance data
  1.  D
  1.  .I $G(DGPRFLG) D PREG^IBCNBME(DFN) Q
  1.  .D REG^IBCNBME(DFN)
  1.  .Q
  1.  S DGRPTOUT=$S($D(DTOUT):-2,$D(DUOUT):-1,1:0)
  1.  Q
  1.  ;
  1. HINQ(DFN,DGRPTOUT) ;HINQ inquiry
  1.  ; Input  -- DFN      Patient IEN
  1.  ; Output -- DGRPTOUT Quit flag
  1.  N DTOUT,IOINHI,IOINORM,X
  1.  S X="IOINHI;IOINORM" D ENDR^%ZISS
  1.  W !!,"---",IOINHI,"HINQ Inquiry",IOINORM,"---"
  1.  ;
  1.  ;HINQ inquiry
  1.  D HINQ^DG10
  1.  S:$G(DTOUT) DGRPTOUT=-2
  1.  Q
  1.  ;
  1. CONCK(DFN,DGRPTOUT) ;Consistency check
  1.  ; Input  -- DFN      Patient IEN
  1.  ; Output -- DGRPTOUT Quit flag
  1.  N DGCD,DGCHK,DGDAY,DGEDCN,DGER,DGLST,DGNCK,DGRPCOLD,DGSC,DGTYPE,DGVT,IOINHI,IOINORM,VA,X
  1.  S X="IOINHI;IOINORM" D ENDR^%ZISS
  1.  W !!,"---",IOINHI,"Consistency Checker",IOINORM,"---"
  1.  ;
  1.  ;Invoke consistency checker
  1.  S DGEDCN=1 D ^DGRPC
  1.  S:$G(DTOUT) DGRPTOUT=-2
  1.  Q
  1.  ;
  1. ASKREG() ;Ask if user would like to register patient
  1.  ; Input  -- None
  1.  ; Output -- 1=Yes and 0=No
  1.  N DIR,DTOUT,DUOUT,Y
  1.  S DIR("A",1)="At this time you may Register the patient if he or she is present and"
  1.  S DIR("A",2)="seeking care.  Answer 'No' if this was a mail-in application."
  1.  S DIR("A",3)=""
  1.  S DIR("A")="Would you like to Register the patient"
  1.  S DIR("B")="YES",DIR(0)="Y"
  1.  W ! D ^DIR
  1.  Q +$G(Y)
  1.  ;
  1. ASKEXT(DGRPTOUT) ;Ask if user would like to exit interview
  1.  ; Input  -- DGRPTOUT Quit flag
  1.  ; Output -- 1=Yes and 0=No
  1.  ;           DGRPTOUT Quit flag re-set
  1.  N DIR,DTOUT,DUOUT,Y
  1.  ;Timeout
  1.  I DGRPTOUT=-2 D
  1.  . S Y=1
  1.  ELSE  D
  1.  . S DIR("A")="Exit Interview"
  1.  . S DIR("B")="YES",DIR(0)="Y"
  1.  . W ! D ^DIR
  1.  . S:$D(DTOUT)!($D(DUOUT)) Y=1
  1.  S:'Y DGRPTOUT=0
  1.  Q +$G(Y)
  1.  ;
  1. ASKPRT() ;Ask if user would like to print the 10-10T
  1.  ; Input  -- None
  1.  ; Output -- 1=Yes and 0=No
  1.  N DIR,DTOUT,DUOUT,Y
  1.  S DIR("A")="PRINT 10/10T"
  1.  S DIR("B")="YES",DIR(0)="Y"
  1.  W ! D ^DIR
  1.  Q +$G(Y)