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