DGMSTL1 ;ALB/SCK - MST Status entry cont. ; 11/15/01 2:27pm
;;5.3;Registration;**195,379**;Aug 13, 1993
Q
PAT ;
N MSTDFN,DGMST,MSTST,MSTPV,MSTDT,DGDTFLG,MSTX,Y
;
D FULL^VALM1
ASKP S MSTDFN=$$SELECT
Q:MSTDFN<0
;
S DGMST=$$GETSTAT^DGMSTAPI(MSTDFN)
K DIRUT
S DIR(0)="29.11,3AO",DIR("B")=$P(DGMST,U,2),DIR("A")="Enter MST Status: "
D ^DIR K DIR
G:$D(DIRUT) ASKP
;
I Y=$P(DGMST,U,2) D G ASKP
. W !!," MST Status has not been changed, Nothing done.",!
S MSTST=Y
;
S MSTDT=$$ASKDATE^DGMSTL2("",+$P(DGMST,U,3))
G:'MSTDT ASKP
;
S MSTPV=$$ASKPROV^DGMSTL2($P(DGMST,U,4))
G:'MSTPV ASKP
;
S MSTX=$$NEWSTAT^DGMSTAPI(MSTDFN,MSTST,MSTDT,MSTPV,"",0)
I +MSTX>0 D
. D ADDSTR^DGMSTL2(MSTDFN,MSTST,MSTDT,MSTPV,+MSTX)
;
I +MSTX<0 D
. W !!,"The following occurred when saving this status:"
. W !,$$EZBLD^DIALOG($P(MSTX,U,2)),!
;
G ASKP
Q
;
STAT ;
N MSTST,MSTDT,MSTPV,MSTDFN,DGMST,DGDTFLG,Y
;
D FULL^VALM1
;
ASKS K DIRUT S DIR(0)="29.11,3AO",DIR("A")="Enter MST status: "
D ^DIR K DIR
Q:$D(DIRUT)!(Y']"")
S MSTST=Y
;
ASKS1 S MSTDFN=$$SELECT
G:MSTDFN<0 ASKS
S DGMST=$$GETSTAT^DGMSTAPI(MSTDFN)
;
S MSTDT=$$ASKDATE^DGMSTL2
G:'MSTDT ASKS1
;
S MSTPV=$$ASKPROV^DGMSTL2($S($G(MSTPV)>0:MSTPV,1:""))
G:'MSTPV ASKS1
;
S MSTX=$$NEWSTAT^DGMSTAPI(MSTDFN,MSTST,MSTDT,MSTPV,"",0)
I +MSTX>0 D
. D ADDSTR^DGMSTL2(MSTDFN,MSTST,MSTDT,MSTPV,MSTX)
;
I +MSTX<0 D
. W !!,"The following occurred when saving this status:"
. W !,$$EZBLD^DIALOG($P(MSTX,U,2)),!
;
G ASKS1
Q
;
EL ; Edit MST status in current List Manager Display
N MSTDFN,DGMST,MSTST,MSTPRV,MSTDT,MSTIEN,DGMSG,MSTIENC,MSTNEW
;
Q:$$CHKNUL^DGMSTL2
D FULL^VALM1
D EN^VALM2(XQORNOD(0),"S")
S VALMI=0,VALMI=$O(VALMY(VALMI)) Q:'VALMI
S MSTIEN=$O(^TMP("DGMST",$J,"IEN",VALMI,0))
Q:(MSTIEN<0)
;
; Retreive information from file entry to be changed
S MSTIENC=+MSTIEN_","
D GETS^DIQ(29.11,MSTIENC,"*","IE","DGMST","DGMSG")
I $D(DGMSG) D Q
. W !!,"Unable to retrieve data at this time."
;
W !!,"Edit MST status for "_DGMST(29.11,MSTIENC,2,"E")
; Enter new MST status code, default is current MST status entered
K DIRUT
S DIR(0)="29.11,3AO",DIR("B")=DGMST(29.11,MSTIENC,3,"E"),DIR("A")="Enter MST Status: "
D ^DIR K DIR
Q:$D(DIRUT)
S MSTST=Y
;
; Ask for provider
S MSTPRV=$$ASKPROV^DGMSTL2(DGMST(29.11,MSTIENC,4,"I"))
Q:'MSTPRV
;
; Ask for status date
S MSTDT=$$ASKDATE^DGMSTL2(DGMST(29.11,MSTIENC,.01,"I"))
Q:'MSTDT
;
W !
K DIRUT
S DIR(0)="YA",DIR("B")="NO",DIR("A")="Save Changes? "
D ^DIR K DIR
Q:$D(DIRUT)!('Y)
;
; Process edit
S MSTNEW(1,29.11,MSTIENC,.01)=MSTDT
S MSTNEW(1,29.11,MSTIENC,3)=MSTST
S MSTNEW(1,29.11,MSTIENC,4)=MSTPRV
S MSTNEW(1,29.11,MSTIENC,5)=DUZ
;
L +^DGMS(29.11,MSTIEN)
D FILE^DIE("S","MSTNEW(1)","DGERR")
L -^DGMS(29.11,MSTIEN)
;
; Update List Manager display
D FLDTEXT^VALM10(VALMI,"DATE",$$FMTE^XLFDT(MSTDT))
D FLDTEXT^VALM10(VALMI,"PROVIDER",$$NAME^DGMSTAPI(MSTPRV))
D FLDTEXT^VALM10(VALMI,"STATUS",MSTST)
Q
;
DL ; Delete entry from list and from the MST HISTORY File (#29.11)
N MSTDFN,DGMST,MSG,MSTST,DGRSLT,DGERR,MSTCNT,MSTIEN,MSTIENC
;
Q:$$CHKNUL^DGMSTL2
;
D FULL^VALM1
; Retrieve entry to delete
D EN^VALM2(XQORNOD(0)) S VALMI=0
M ^TMP("DGMST RENUM",$J)=^TMP("DGMST",$J)
F S VALMI=$O(VALMY(VALMI)) Q:'VALMI D
. S MSTIEN=$O(^TMP("DGMST",$J,"IEN",VALMI,0))
. D GETS^DIQ(29.11,MSTIEN_",","*","I","DGMST","DGERR")
. Q:$D(DGERR)
. Q:'($$CONFIRM(DGMST(29.11,MSTIEN_",",2,"I"),DGMST(29.11,MSTIEN_",",3,"I")))
. S DGRSLT=$$DELMST^DGMSTAPI(MSTIEN)
. I DGRSLT D
.. K ^TMP("DGMST RENUM",$J,"IDX",VALMI)
. E D
. W !!,$P(DGRSLT,U,2)
;
S (VALMCNT,MSTCNT,IDX)=0
K ^TMP("DGMST",$J)
F S IDX=$O(^TMP("DGMST RENUM",$J,"IDX",IDX)) Q:'IDX D
. S MSTIEN=$O(^TMP("DGMST RENUM",$J,"IEN",IDX,0)),MSTIENC=MSTIEN_","
. D GETS^DIQ(29.11,MSTIENC,"*","I","DGMST")
. D ADDSTR^DGMSTL2(DGMST(29.11,MSTIENC,2,"I"),DGMST(29.11,MSTIENC,3,"I"),DGMST(29.11,MSTIENC,.01,"I"),DGMST(29.11,MSTIENC,4,"I"),MSTIEN)
;
D NUL^DGMSTL2
Q
;
DP ; Display patient MST status history for a patient not in the current liST
;
N DIC,MSTDFN
K ^TMP("DGMST DP",$J)
;
D FULL^VALM1
S MSTDFN=$$SELECT
;
I MSTDFN<0 D Q
. W !?5,"No patient found"
. S VALMBCK="R"
;
D EN^VALM("DGMST STATUS DISPLAY")
S VALMBCK="R"
Q
;
SENDMST ; Send HL7 messages for current list
N MSTDFN,DGRSLT,IDX
S MSTDFN=""
D FULL^VALM1
Q:'$D(^TMP("DGMST",$J,"DFN"))
W !!,"Queuing MST updates for HL7 processing..." D HANG
S IDX=""
F S IDX=$O(^TMP("DGMST",$J,"DFN",IDX)) Q:'IDX D
. S MSTDFN=$O(^TMP("DGMST",$J,"DFN",IDX,0))
. Q:'MSTDFN
. D SEND(MSTDFN,"Z07")
W !!,"Queuing completed..." D HANG
Q
;
SEND(DFN,EVNT) ; Send HL7 message
N HLRSLT
S DFN=$G(DFN)
S EVNT=$G(EVNT)
I EVNT="Z07" D AUTOUPD^DGENA2(DFN)
Q
;
SELECT() ;
N DGRSLT
;
K DIRUT
S DIC=2,DIC(0)="AEMQZ",DIC("A")="Select Patient: "
S DIC("S")="I $G(^(""VET""))=""Y"",'+$G(^(.35))>0!(+$G(^(.35))>0&(+$G(^(.35))'<2921001))"
D ^DIC K DIC
I $D(DIRUT)!(Y="") S DGRSLT=-1
E D
. S DGRSLT=+Y
Q $G(DGRSLT)
;
CONFIRM(MSTDFN,MSTST) ; Confirm deletion of patient's MST status
; Confirm deletion for this patient
K DIRUT
S DIR("A",1)=""
S DIR("A",2)=$P(^DPT(MSTDFN,0),U)_" has a current status of "_$$EXTMST^DGMSTL2(MSTST)
S DIR(0)="YA",DIR("B")="NO"
S DIR("A")="Delete this MST status entry? "
D ^DIR K DIR
Q:$D(DIRUT) 0
Q $G(Y)
;
HANG ; This logic allows the messages to display briefly to the User.
R DGPTHANG:4 K DGPTHANG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMSTL1 5645 printed Dec 13, 2024@02:44:27 Page 2
DGMSTL1 ;ALB/SCK - MST Status entry cont. ; 11/15/01 2:27pm
+1 ;;5.3;Registration;**195,379**;Aug 13, 1993
+2 QUIT
PAT ;
+1 NEW MSTDFN,DGMST,MSTST,MSTPV,MSTDT,DGDTFLG,MSTX,Y
+2 ;
+3 DO FULL^VALM1
ASKP SET MSTDFN=$$SELECT
+1 if MSTDFN<0
QUIT
+2 ;
+3 SET DGMST=$$GETSTAT^DGMSTAPI(MSTDFN)
+4 KILL DIRUT
+5 SET DIR(0)="29.11,3AO"
SET DIR("B")=$PIECE(DGMST,U,2)
SET DIR("A")="Enter MST Status: "
+6 DO ^DIR
KILL DIR
+7 if $DATA(DIRUT)
GOTO ASKP
+8 ;
+9 IF Y=$PIECE(DGMST,U,2)
Begin DoDot:1
+10 WRITE !!," MST Status has not been changed, Nothing done.",!
End DoDot:1
GOTO ASKP
+11 SET MSTST=Y
+12 ;
+13 SET MSTDT=$$ASKDATE^DGMSTL2("",+$PIECE(DGMST,U,3))
+14 if 'MSTDT
GOTO ASKP
+15 ;
+16 SET MSTPV=$$ASKPROV^DGMSTL2($PIECE(DGMST,U,4))
+17 if 'MSTPV
GOTO ASKP
+18 ;
+19 SET MSTX=$$NEWSTAT^DGMSTAPI(MSTDFN,MSTST,MSTDT,MSTPV,"",0)
+20 IF +MSTX>0
Begin DoDot:1
+21 DO ADDSTR^DGMSTL2(MSTDFN,MSTST,MSTDT,MSTPV,+MSTX)
End DoDot:1
+22 ;
+23 IF +MSTX<0
Begin DoDot:1
+24 WRITE !!,"The following occurred when saving this status:"
+25 WRITE !,$$EZBLD^DIALOG($PIECE(MSTX,U,2)),!
End DoDot:1
+26 ;
+27 GOTO ASKP
+28 QUIT
+29 ;
STAT ;
+1 NEW MSTST,MSTDT,MSTPV,MSTDFN,DGMST,DGDTFLG,Y
+2 ;
+3 DO FULL^VALM1
+4 ;
ASKS KILL DIRUT
SET DIR(0)="29.11,3AO"
SET DIR("A")="Enter MST status: "
+1 DO ^DIR
KILL DIR
+2 if $DATA(DIRUT)!(Y']"")
QUIT
+3 SET MSTST=Y
+4 ;
ASKS1 SET MSTDFN=$$SELECT
+1 if MSTDFN<0
GOTO ASKS
+2 SET DGMST=$$GETSTAT^DGMSTAPI(MSTDFN)
+3 ;
+4 SET MSTDT=$$ASKDATE^DGMSTL2
+5 if 'MSTDT
GOTO ASKS1
+6 ;
+7 SET MSTPV=$$ASKPROV^DGMSTL2($SELECT($GET(MSTPV)>0:MSTPV,1:""))
+8 if 'MSTPV
GOTO ASKS1
+9 ;
+10 SET MSTX=$$NEWSTAT^DGMSTAPI(MSTDFN,MSTST,MSTDT,MSTPV,"",0)
+11 IF +MSTX>0
Begin DoDot:1
+12 DO ADDSTR^DGMSTL2(MSTDFN,MSTST,MSTDT,MSTPV,MSTX)
End DoDot:1
+13 ;
+14 IF +MSTX<0
Begin DoDot:1
+15 WRITE !!,"The following occurred when saving this status:"
+16 WRITE !,$$EZBLD^DIALOG($PIECE(MSTX,U,2)),!
End DoDot:1
+17 ;
+18 GOTO ASKS1
+19 QUIT
+20 ;
EL ; Edit MST status in current List Manager Display
+1 NEW MSTDFN,DGMST,MSTST,MSTPRV,MSTDT,MSTIEN,DGMSG,MSTIENC,MSTNEW
+2 ;
+3 if $$CHKNUL^DGMSTL2
QUIT
+4 DO FULL^VALM1
+5 DO EN^VALM2(XQORNOD(0),"S")
+6 SET VALMI=0
SET VALMI=$ORDER(VALMY(VALMI))
if 'VALMI
QUIT
+7 SET MSTIEN=$ORDER(^TMP("DGMST",$JOB,"IEN",VALMI,0))
+8 if (MSTIEN<0)
QUIT
+9 ;
+10 ; Retreive information from file entry to be changed
+11 SET MSTIENC=+MSTIEN_","
+12 DO GETS^DIQ(29.11,MSTIENC,"*","IE","DGMST","DGMSG")
+13 IF $DATA(DGMSG)
Begin DoDot:1
+14 WRITE !!,"Unable to retrieve data at this time."
End DoDot:1
QUIT
+15 ;
+16 WRITE !!,"Edit MST status for "_DGMST(29.11,MSTIENC,2,"E")
+17 ; Enter new MST status code, default is current MST status entered
+18 KILL DIRUT
+19 SET DIR(0)="29.11,3AO"
SET DIR("B")=DGMST(29.11,MSTIENC,3,"E")
SET DIR("A")="Enter MST Status: "
+20 DO ^DIR
KILL DIR
+21 if $DATA(DIRUT)
QUIT
+22 SET MSTST=Y
+23 ;
+24 ; Ask for provider
+25 SET MSTPRV=$$ASKPROV^DGMSTL2(DGMST(29.11,MSTIENC,4,"I"))
+26 if 'MSTPRV
QUIT
+27 ;
+28 ; Ask for status date
+29 SET MSTDT=$$ASKDATE^DGMSTL2(DGMST(29.11,MSTIENC,.01,"I"))
+30 if 'MSTDT
QUIT
+31 ;
+32 WRITE !
+33 KILL DIRUT
+34 SET DIR(0)="YA"
SET DIR("B")="NO"
SET DIR("A")="Save Changes? "
+35 DO ^DIR
KILL DIR
+36 if $DATA(DIRUT)!('Y)
QUIT
+37 ;
+38 ; Process edit
+39 SET MSTNEW(1,29.11,MSTIENC,.01)=MSTDT
+40 SET MSTNEW(1,29.11,MSTIENC,3)=MSTST
+41 SET MSTNEW(1,29.11,MSTIENC,4)=MSTPRV
+42 SET MSTNEW(1,29.11,MSTIENC,5)=DUZ
+43 ;
+44 LOCK +^DGMS(29.11,MSTIEN)
+45 DO FILE^DIE("S","MSTNEW(1)","DGERR")
+46 LOCK -^DGMS(29.11,MSTIEN)
+47 ;
+48 ; Update List Manager display
+49 DO FLDTEXT^VALM10(VALMI,"DATE",$$FMTE^XLFDT(MSTDT))
+50 DO FLDTEXT^VALM10(VALMI,"PROVIDER",$$NAME^DGMSTAPI(MSTPRV))
+51 DO FLDTEXT^VALM10(VALMI,"STATUS",MSTST)
+52 QUIT
+53 ;
DL ; Delete entry from list and from the MST HISTORY File (#29.11)
+1 NEW MSTDFN,DGMST,MSG,MSTST,DGRSLT,DGERR,MSTCNT,MSTIEN,MSTIENC
+2 ;
+3 if $$CHKNUL^DGMSTL2
QUIT
+4 ;
+5 DO FULL^VALM1
+6 ; Retrieve entry to delete
+7 DO EN^VALM2(XQORNOD(0))
SET VALMI=0
+8 MERGE ^TMP("DGMST RENUM",$JOB)=^TMP("DGMST",$JOB)
+9 FOR
SET VALMI=$ORDER(VALMY(VALMI))
if 'VALMI
QUIT
Begin DoDot:1
+10 SET MSTIEN=$ORDER(^TMP("DGMST",$JOB,"IEN",VALMI,0))
+11 DO GETS^DIQ(29.11,MSTIEN_",","*","I","DGMST","DGERR")
+12 if $DATA(DGERR)
QUIT
+13 if '($$CONFIRM(DGMST(29.11,MSTIEN_",",2,"I"),DGMST(29.11,MSTIEN_",",3,"I")))
QUIT
+14 SET DGRSLT=$$DELMST^DGMSTAPI(MSTIEN)
+15 IF DGRSLT
Begin DoDot:2
+16 KILL ^TMP("DGMST RENUM",$JOB,"IDX",VALMI)
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
End DoDot:2
+18 WRITE !!,$PIECE(DGRSLT,U,2)
End DoDot:1
+19 ;
+20 SET (VALMCNT,MSTCNT,IDX)=0
+21 KILL ^TMP("DGMST",$JOB)
+22 FOR
SET IDX=$ORDER(^TMP("DGMST RENUM",$JOB,"IDX",IDX))
if 'IDX
QUIT
Begin DoDot:1
+23 SET MSTIEN=$ORDER(^TMP("DGMST RENUM",$JOB,"IEN",IDX,0))
SET MSTIENC=MSTIEN_","
+24 DO GETS^DIQ(29.11,MSTIENC,"*","I","DGMST")
+25 DO ADDSTR^DGMSTL2(DGMST(29.11,MSTIENC,2,"I"),DGMST(29.11,MSTIENC,3,"I"),DGMST(29.11,MSTIENC,.01,"I"),DGMST(29.11,MSTIENC,4,"I"),MSTIEN)
End DoDot:1
+26 ;
+27 DO NUL^DGMSTL2
+28 QUIT
+29 ;
DP ; Display patient MST status history for a patient not in the current liST
+1 ;
+2 NEW DIC,MSTDFN
+3 KILL ^TMP("DGMST DP",$JOB)
+4 ;
+5 DO FULL^VALM1
+6 SET MSTDFN=$$SELECT
+7 ;
+8 IF MSTDFN<0
Begin DoDot:1
+9 WRITE !?5,"No patient found"
+10 SET VALMBCK="R"
End DoDot:1
QUIT
+11 ;
+12 DO EN^VALM("DGMST STATUS DISPLAY")
+13 SET VALMBCK="R"
+14 QUIT
+15 ;
SENDMST ; Send HL7 messages for current list
+1 NEW MSTDFN,DGRSLT,IDX
+2 SET MSTDFN=""
+3 DO FULL^VALM1
+4 if '$DATA(^TMP("DGMST",$JOB,"DFN"))
QUIT
+5 WRITE !!,"Queuing MST updates for HL7 processing..."
DO HANG
+6 SET IDX=""
+7 FOR
SET IDX=$ORDER(^TMP("DGMST",$JOB,"DFN",IDX))
if 'IDX
QUIT
Begin DoDot:1
+8 SET MSTDFN=$ORDER(^TMP("DGMST",$JOB,"DFN",IDX,0))
+9 if 'MSTDFN
QUIT
+10 DO SEND(MSTDFN,"Z07")
End DoDot:1
+11 WRITE !!,"Queuing completed..."
DO HANG
+12 QUIT
+13 ;
SEND(DFN,EVNT) ; Send HL7 message
+1 NEW HLRSLT
+2 SET DFN=$GET(DFN)
+3 SET EVNT=$GET(EVNT)
+4 IF EVNT="Z07"
DO AUTOUPD^DGENA2(DFN)
+5 QUIT
+6 ;
SELECT() ;
+1 NEW DGRSLT
+2 ;
+3 KILL DIRUT
+4 SET DIC=2
SET DIC(0)="AEMQZ"
SET DIC("A")="Select Patient: "
+5 SET DIC("S")="I $G(^(""VET""))=""Y"",'+$G(^(.35))>0!(+$G(^(.35))>0&(+$G(^(.35))'<2921001))"
+6 DO ^DIC
KILL DIC
+7 IF $DATA(DIRUT)!(Y="")
SET DGRSLT=-1
+8 IF '$TEST
Begin DoDot:1
+9 SET DGRSLT=+Y
End DoDot:1
+10 QUIT $GET(DGRSLT)
+11 ;
CONFIRM(MSTDFN,MSTST) ; Confirm deletion of patient's MST status
+1 ; Confirm deletion for this patient
+2 KILL DIRUT
+3 SET DIR("A",1)=""
+4 SET DIR("A",2)=$PIECE(^DPT(MSTDFN,0),U)_" has a current status of "_$$EXTMST^DGMSTL2(MSTST)
+5 SET DIR(0)="YA"
SET DIR("B")="NO"
+6 SET DIR("A")="Delete this MST status entry? "
+7 DO ^DIR
KILL DIR
+8 if $DATA(DIRUT)
QUIT 0
+9 QUIT $GET(Y)
+10 ;
HANG ; This logic allows the messages to display briefly to the User.
+1 READ DGPTHANG:4
KILL DGPTHANG
+2 QUIT
