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

DGHTENR.m

Go to the documentation of this file. 
  1. DGHTENR ;ALB/JAM - Home Telehealth Patient Sign-up;10 January 2005 ; 9/20/07 8:27am
  1.  ;;5.3;Registration;**644,1016**;Aug 13, 1993;Build 20
  1.  ;
  1. EN N DGDFN,STOP,ARR,RESULT,DGVEN,DGPRV,DGCON,GETOK,DGHTH,DGMID,DGCHK,DGDEF
  1.  N DGEVNDT,VENDOR,DGTYPE
  1.  S ARR=$NA(HLA("HLS"))
  1.  S STOP=0
  1.  F  D  Q:STOP
  1.  .K DGHTH
  1.  .S DGHTH("DGTYPE")="A"
  1.  .;Get patient
  1.  .W !!
  1.  .S DGDFN=$$GETPAT() I 'DGDFN S STOP=1 Q
  1.  .S DGHTH("DFN")=DGDFN
  1.  .;Get receiving vendor
  1.  .S DGVEN=$$GETVEN() I 'DGVEN Q
  1.  .S DGHTH("VENDOR")=DGVEN
  1.  .;Check if Patient is already signed up
  1.  .S DGCHK=$$SGNUPCHK(.DGHTH)
  1.  .I 'DGCHK W "  ...Patient Sign-Up/Activation request terminated." Q
  1.  .;Get consult number
  1.  .S DGDEF=$G(DGHTH("CONSULT")),DGCON=$$GCONSULT(DGDFN,DGDEF) I 'DGCON Q
  1.  .S DGHTH("CONSULT")=DGCON
  1.  .;Get Care Coordinator
  1.  .S DGDEF=$G(DGHTH("COORD")),DGPRV=$$GETPROV(DGDEF) I 'DGPRV Q
  1.  .S DGHTH("COORD")=DGPRV
  1.  .;Get okay for transmission
  1.  .S GETOK=$$SNDMSG(DGHTH("DGTYPE"))
  1.  .I 'GETOK W "  ...Patient record not transmitted." Q
  1.  .;file patient data in #391.31
  1.  .S DGEVNDT=$$NOW^XLFDT(),DGHTH("EVENTDT")=DGEVNDT
  1.  .D FILE
  1.  .;build message
  1.  .W !!,"Generating HL7 message ..."
  1.  .K @ARR
  1.  .S RESULT=$$BLDHL7^DGHTHL7(.DGHTH,ARR)
  1.  .I +RESULT<0 D  Q
  1.  ..W !,"** UNABLE TO BUILD MESSAGE **",!,$P(RESULT,"^",2) K @ARR
  1.  .I RESULT=0 D  Q
  1.  ..W !,"** EMPTY MESSAGE BUILT **" K @ARR
  1.  .;send message
  1.  .W !,"Sending message ..."
  1.  .S RESULT=$$SNDHL7^DGHTHL7(ARR,DGVEN,"DG HOME TELEHEALTH ADT-A04 SERVER")
  1.  .I $P(RESULT,"^",2)'="" D  Q
  1.  ..W !,"** UNABLE TO SEND MESSAGE **"
  1.  ..W !,"Error Code: ",$P(RESULT,"^",2),"  Message: ",$P(RESULT,"^",3)
  1.  ..K @ARR
  1.  .;Update File #391.31 with message ID
  1.  .S DGMID=$P(RESULT,"^")
  1.  .D MIDUPD
  1.  .W !,"Sent using message ID ",$P(RESULT,"^")
  1.  .K @ARR
  1.  Q
  1.  ;
  1. SGNUPCHK(DGARY)        ;Check if patient already signed up & whether to 
  1.  ;continue signup for transmission
  1.  ;Input : Array with patient data with at least patient & vendor IEN
  1.  ;Output: 0 = Patient was signed up, terminate processing 
  1.  ;        1 = Continue processing
  1.  ;
  1.  N X,Y,DA,DA1,DAIEN,DGDAT,DTOUT,DUOUT,DIR
  1.  S X="" F  S X=$O(DGARY(X)) Q:X=""  D
  1.  .I DGARY(X)="" K DGARY(X) Q
  1.  .S @X=DGARY(X)
  1.  I '$G(DFN)!('$G(VENDOR))!($G(DGTYPE)="") Q 1
  1.  S DAIEN=$$LOCREC^DGHTINAC(DFN,VENDOR,DGTYPE)
  1.  I 'DAIEN Q 1
  1.  W @IOF,!,"PATIENT ALREADY SIGNED-UP/ACTIVATED WITH VENDOR",!!
  1.  D DSPREC(DAIEN)
  1.  S DIR(0)="Y",DIR("A")="Continue Patient Sign-Up/Activation",DIR("B")="No"
  1.  S DIR("?")="Enter NO to terminate sign-up/activation or YES to continue sign-up/activation."
  1.  D ^DIR I Y D
  1.  .S DGDAT=^DGHT(391.31,$P(DAIEN,"^"),0),DGARY("DA")=DAIEN
  1.  .S DGARY("CONSULT")=$P(DGDAT,"^",4),DGARY("COORD")=$P(DGDAT,"^",5)
  1.  W !
  1.  Q $S(+Y<0:0,1:+Y)
  1.  ;
  1. DSPREC(DGIEN) ;Display Home Telehealth record
  1.  ;Input : IEN and sub IEN for Home Telehealth files #391.31 & #391.317
  1.  ;Output: Displays record if found
  1.  ;
  1.  N DA,DA1,DGDAT,DGDAT1
  1.  I $G(DGIEN)="" Q
  1.  S DA=$P(DGIEN,"^"),DA1=$P(DGIEN,"^",2)
  1.  I '+DA Q
  1.  S DGDAT=^DGHT(391.31,DA,0)
  1.  S DGDAT1=$S(DA1:^DGHT(391.31,DA,"TRAN",DA1,0),1:"")
  1.  W !?3,"Patient:          ",$$GET1^DIQ(2,$P(DGDAT,"^",2),.01,"E")
  1.  W !?3,"Vendor:           ",$$GET1^DIQ(4,$P(DGDAT,"^",3),.01,"E")
  1.  W !?3,"Care Coordinator: ",$$GET1^DIQ(200,$P(DGDAT,"^",5),.01,"E")
  1.  W ?45,"Consult Number:    ",$P(DGDAT,"^",4)
  1.  W !?3,"Activation Date:  ",$$FMTE^XLFDT($P(DGDAT,"^",6),2)
  1.  W:$P(DGDAT,"^",7)'="" ?45,"Inactivation Date: ",$$FMTE^XLFDT($P(DGDAT,"^",7),2)
  1.  I DGDAT1'="" D
  1.  .W !?3,"Transaction Date: ",$$FMTE^XLFDT($P(DGDAT1,"^"),2)
  1.  .W ?45,"Transaction Type:  "
  1.  .W $S('$P(DGDAT1,"^",5):"Retransmit",$P(DGDAT1,"^",5)=1:"Add",1:"Edit")
  1.  .W !?3,"Message Type:     ",$S($P(DGDAT1,"^",4)="A":"Activation",$P(DGDAT1,"^",4)="I":"Inactivation",1:"Unknown")
  1.  .W ?45,"Message ID:        ",$P(DGDAT1,"^",2)
  1.  .W !?3,"Data Entry User:  ",$$GET1^DIQ(200,$P(DGDAT1,"^",3),.01,"E")
  1.  .W !?3,"Acknowledge Date: ",$$FMTE^XLFDT($P(DGDAT1,"^",6),2)
  1.  .W ?45,"Acknowledge Code:  "
  1.  .W $S($P(DGDAT1,"^",7)="A":"Accepted",$P(DGDAT1,"^",7)="R":"Rejected",1:"")
  1.  .I $P(DGDAT1,"^",8)'="" W !?3,"Reject Message:   ",$P(DGDAT1,"^",8)
  1.  .W !
  1.  Q
  1.  ;
  1. GETPAT()        ;Prompt user for patient
  1.  ;Input : None
  1.  ;Output: Pointer to PATIENT File, #2 (i.e. DFN)
  1.  ;        0 on user quit
  1.  N DIC,X,Y,DTOUT,DUOUT,IENVAL
  1.  S DIC="^DPT(",DIC("A")="Patient: ",DIC(0)="AEQM"
  1.  D ^DIC I +Y<0 Q 0
  1.  S IENVAL=$$PATOK(+Y) I 'IENVAL Q 0
  1.  Q +Y
  1.  ;
  1. PATOK(DFN)      ;Patient screen
  1.  ;Input : DFN - Pointer to PATIENT
  1.  ;Output: 1 = Patient selectable
  1.  ;        0 = Patient not selectable
  1.  N NODE
  1.  ;Dead
  1.  I $G(^DPT(DFN,.35)) W !,"*** Patient has expired. ***" Q 0
  1.  ;No national ICN
  1.  S NODE=$G(^DPT(DFN,"MPI"))
  1.  I $P(NODE,"^",1)="" W !,"*** Patient has no ICN. ***" Q 0
  1.  ;Local ICN
  1.  I $P(NODE,"^",4) W !,"*** Patient has local ICN. ***" Q 0
  1.  ;Selectable patient
  1.  Q 1
  1.  ;
  1. GETVEN() ;Prompt user for receiving vendor
  1.  ;Input : None
  1.  ;Output: N = Pointer to INSTITUTION File, #4
  1.  ;        0 = User quit
  1.  ;
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT
  1.  S DIR(0)="391.31,2",DIR("A")="Vendor"
  1.  S DIR("?")="Enter the Home Telehealth vendor patient is signed up with."
  1.  D ^DIR
  1.  Q $S(+Y<0:0,1:+Y)
  1.  ;
  1. GCONSULT(DFN,DEFAULT) ;Prompt Consult number from file #123
  1.  ;Input : DFN      Patient pointer for file #2
  1.  ;        DEFAULT  Default value for consult number (if existing)
  1.  ;Output: N        Pointer to REQUEST/CONSULTATION file, #123
  1.  ;        0        User quit
  1.  ;
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT,CON,CONZER,DGTMP
  1.  ;find ien for 'CARE COORDINATION HOME TELEHEALTH SCREENING'
  1.  S CON="CARE COORDINATION HOME TELEHEALTH SCREENING"
  1.  K ^TMP("GMRCR",$J)
  1.  D GUI^GMRCASV1("DGTMP",CON,1,0) ;DBIA#3252
  1.  S CON=$O(DGTMP(0))
  1.  I 'CON W !,"Service Area not available" Q 0
  1.  S CON=+DGTMP(CON) ;DBIA#2740
  1.  D OER^GMRCSLM1(DFN,CON,"")
  1.  S CONZER=$G(^TMP("GMRCR",$J,"CS",0)),DIR("?")="^D CONHELP^DGHTENR"
  1.  I '+$P(CONZER,"^",4) D  Q 0
  1.  .W !!,"No Home Telehealth consult available for this patient!!"
  1.  S DIR(0)="P^TMP(""GMRCR"",$J,""CS"",:AEQMZ",DIR("A")="Consult Number"
  1.  I $G(DEFAULT)'="" S DIR("B")=DEFAULT
  1.  D ^DIR
  1.  K ^TMP("GMRCR",$J)
  1.  Q $S(+Y<0:0,1:$P(Y,"^",2))
  1.  ;
  1. CONHELP ;Help for consult #
  1.  N DIC,XX,D
  1.  I $D(^TMP("GMRCR",$J,"CS")) D  Q
  1.  .W !?1,"Answer with the number representing consult.",!?1,"Choose from:"
  1.  .S XX=0 F  S XX=$O(^TMP("GMRCR",$J,"CS",XX)) Q:'XX  D
  1.  ..W !?1,XX,")",?5,$P(^TMP("GMRCR",$J,"CS",XX,0),"^"),?15
  1.  ..W $$FMTE^XLFDT($P(^TMP("GMRCR",$J,"CS",XX,0),"^",2),"2HM"),?30
  1.  ..W $E($P(^TMP("GMRCR",$J,"CS",XX,0),"^",7),1,38),?70,$P(^TMP("GMRCR",$J,"CS",XX,0),"^",3)
  1.  S DIC="^TMP(""GMRCR"",$J,""CS"")",DIC(0)="MQEZ" D DQ^DICQ
  1.  Q
  1.  ;
  1. GETPROV(DEFAULT) ;Prompt for Care Coordinator
  1.  ;Input : DEFAULT = Default value for provider (if existing)
  1.  ;Output: N =       Pointer to NEW PERSON file, #200
  1.  ;        0 =       User quit
  1.  ;
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT
  1.  S DIR(0)="P^VA(200,:AEQM",DIR("A")="Care Coordinator"
  1.  S DIR("?")="Enter the Care Coordinator responsible for signing up this patient."
  1.  I $G(DEFAULT)'="" S DIR("B")=$$GET1^DIQ(200,DEFAULT,.01,"E")
  1.  D ^DIR
  1.  Q $S(+Y<0:0,1:+Y)
  1.  ;
  1. SNDMSG(TYPE)        ;Prompt to transmit transaction to vendor server
  1.  ;Input : None
  1.  ;Output: 1 = Send message
  1.  ;        0 = User quit
  1.  ;
  1.  N DIR,X,Y,DTOUT,DUOUT,DIRUT
  1.  S DIR(0)="Y",DIR("B")="Yes"
  1.  S DIR("A")=$S(TYPE="A":"Send Sign-Up/Activation",TYPE="I":"Send Inactivation",1:"")
  1.  S DIR("?")="Enter 'Yes' to transmit patient information to vendor. 'No' not to transmit."
  1.  D ^DIR
  1.  Q $S(+Y<0:0,1:+Y)
  1.  ;
  1. FILE ;File patient data in #391.31
  1.  N DIC,DIE,DA,DR,X,Y,DGRN,DGTREVN,DINUM
  1.  S DGTREVN=0
  1.  I $G(DGHTH("DA"))'="" D  Q
  1.  .D FILE1
  1. HTADD L +^DGHT(391.31,0)
  1.  S DGRN=$P(^DGHT(391.31,0),"^",3)+1 I $D(^DGHT(391.31,DGRN)) D  G HTADD
  1.  .S $P(^DGHT(391.31,0),"^",3)=$P(^(0),"^",3)+1 L -^DGHT(391.31,0)
  1.  L -^DGHT(391.31,0)
  1.  S DIC(0)="L",DIC="^DGHT(391.31,",X=DGRN,DINUM=X D FILE^DICN
  1.  S DGHTH("DA")=+Y,DGTREVN=1
  1.  ;
  1. FILE1 ;Add/Update fields in #391.31
  1.  S DIE="^DGHT(391.31,",DA=+DGHTH("DA")
  1.  S DR="1////"_DGDFN_";2////"_DGVEN_";3////"_DGCON_";4////"_DGPRV
  1.  S:DGTREVN DR=DR_";5////"_DGEVNDT
  1.  D ^DIE
  1.  ;file entry in subfile #391.317
  1.  K DIC,DD,DO,DA
  1.  S DIC(0)="L",DIC("P")=$P(^DD(391.31,7,0),"^",2),DA(1)=+DGHTH("DA")
  1.  I $P(DGHTH("DA"),"^",2)="" D
  1.  .S DGRN=$S('$D(^DGHTH(391.31,DA(1),"TRAN")):0,1:$P(^DGHTH(391.31,DA(1),"TRAN",0),"^",3))+1,$P(DGHTH("DA"),"^",2)=DGRN,X=DGEVNDT
  1.  .S DIC="^DGHT(391.31,"_DA(1)_","_"""TRAN"""_","
  1.  .D FILE^DICN
  1.  K DR
  1.  S DA=$P(DGHTH("DA"),"^",2),DIE="^DGHT(391.31,"_DA(1)_","_"""TRAN"""_","
  1.  S (DR,DR(2,391.317))=".01////"_DGEVNDT_";.02////@"_";.03////"_DUZ_";.04////"_DGTYPE_";.05////"_DGTREVN  ;";.07////@" retain AA and trans. date/time when 1st transmitted successfully.
  1.  D ^DIE
  1.  Q
  1.  ;
  1. MIDUPD ;Update File #391.31 with message ID
  1.  N DIE,DR,DA,X,Y
  1.  S DA=$P(DGHTH("DA"),"^",2),DA(1)=+DGHTH("DA")
  1.  S (DR,DR(2,391.317))=".02////"_DGMID
  1.  S DIE="^DGHT(391.31,"_DA(1)_","_"""TRAN"""_","
  1.  D ^DIE
  1.  Q