GMRCGUIS ;ALB/TDP - update Consult Status ;4/26/2006
;;3.0;CONSULT/REQUEST TRACKING;**52,46**;DEC 27, 1997;Build 23
;
;Called by SDCNSLT for Scheduling Consult Appointment Linkage
STATUS(GMRCO,GMRCSTS,GMRCA,GMRCORNP,GMRCAD,GMRCADUZ,GMRCMT) ;Change status/last action/add comment consult API
; Input variables:
;GMRCO - The internal file number of the consult from File 123
;GMRCSTS - Status of the consult
;GMRCA - Last Action to be added to the consult
;GMRCORNP - Name of the person who actually 'Received' the consult
;GMRCAD - Actual date time that consult was received into the service.
;GMRCADUZ - array of alert recipients as chosen by user (by reference)
; ARRAY(DUZ)=""
;GMRCMT - array of comments if entered (by reference)
; ARRAY(1)="FIRST LINE OF COMMENT"
; ARRAY(2)="SECOND LINE OF COMMENT"
;
;Output:
;GMRCERR - Error Condition Code: 0 = NO error, 1=error
;GMRCERMS - Error message or null
; returned as GMRCERR^GMRCERMS
;
N DFN,GMRCNOW,GMRCERR,GMRCERMS
S GMRCERR=0,GMRCERMS="",GMRCNOW=$$NOW^XLFDT,GMRCMT=0
I 'GMRCSTS!('GMRCA) D Q GMRCERR_"^"_GMRCERMS
. S GMRCERR="1",GMRCERMS="Status/last action update is missing or wrong."
. D EXIT^GMRCGUIA
S:$G(GMRCAD)="" GMRCAD=GMRCNOW
S:'$G(GMRCDUZ) GMRCDUZ=DUZ
S DFN=$P($G(^GMR(123,GMRCO,0)),"^",2) I DFN="" D Q GMRCERR_"^"_GMRCERMS
. S GMRCERR="1",GMRCERMS="Not A Valid Consult - File Not Found."
. D EXIT^GMRCGUIA
D STATUS^GMRCP I $D(GMRCQUT) D EXIT^GMRCGUIA Q GMRCERR_"^"_GMRCERMS
I '$O(GMRCMT(0)) D AUDIT^GMRCP
I $O(GMRCMT(0)) D
. S DA=$$SETDA^GMRCGUIB
. S GMRCMT(0)=DA,GMRCMT=1
. D SETCOM^GMRCGUIB(.GMRCMT,GMRCDUZ)
D EN^GMRCHL7(DFN,GMRCO,"","","SC",GMRCORNP,"",.GMRCMT,"",GMRCAD)
D ;send alerts
. N TXT
. S TXT="Comment Added to Consult "_$$ORTX^GMRCAU(GMRCO)
. I $P(^GMR(123,+GMRCO,0),U,14),$P(^GMR(123,+GMRCO,0),U,14)'=DUZ S GMRCADUZ($P(^(0),U,14))=""
. D MSG^GMRCP(DFN,TXT,GMRCO,63,.GMRCADUZ,0)
D EXIT^GMRCGUIA
Q GMRCERR_"^"_GMRCERMS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCGUIS 1999 printed Oct 16, 2024@17:46:32 Page 2
GMRCGUIS ;ALB/TDP - update Consult Status ;4/26/2006
+1 ;;3.0;CONSULT/REQUEST TRACKING;**52,46**;DEC 27, 1997;Build 23
+2 ;
+3 ;Called by SDCNSLT for Scheduling Consult Appointment Linkage
STATUS(GMRCO,GMRCSTS,GMRCA,GMRCORNP,GMRCAD,GMRCADUZ,GMRCMT) ;Change status/last action/add comment consult API
+1 ; Input variables:
+2 ;GMRCO - The internal file number of the consult from File 123
+3 ;GMRCSTS - Status of the consult
+4 ;GMRCA - Last Action to be added to the consult
+5 ;GMRCORNP - Name of the person who actually 'Received' the consult
+6 ;GMRCAD - Actual date time that consult was received into the service.
+7 ;GMRCADUZ - array of alert recipients as chosen by user (by reference)
+8 ; ARRAY(DUZ)=""
+9 ;GMRCMT - array of comments if entered (by reference)
+10 ; ARRAY(1)="FIRST LINE OF COMMENT"
+11 ; ARRAY(2)="SECOND LINE OF COMMENT"
+12 ;
+13 ;Output:
+14 ;GMRCERR - Error Condition Code: 0 = NO error, 1=error
+15 ;GMRCERMS - Error message or null
+16 ; returned as GMRCERR^GMRCERMS
+17 ;
+18 NEW DFN,GMRCNOW,GMRCERR,GMRCERMS
+19 SET GMRCERR=0
SET GMRCERMS=""
SET GMRCNOW=$$NOW^XLFDT
SET GMRCMT=0
+20 IF 'GMRCSTS!('GMRCA)
Begin DoDot:1
+21 SET GMRCERR="1"
SET GMRCERMS="Status/last action update is missing or wrong."
+22 DO EXIT^GMRCGUIA
End DoDot:1
QUIT GMRCERR_"^"_GMRCERMS
+23 if $GET(GMRCAD)=""
SET GMRCAD=GMRCNOW
+24 if '$GET(GMRCDUZ)
SET GMRCDUZ=DUZ
+25 SET DFN=$PIECE($GET(^GMR(123,GMRCO,0)),"^",2)
IF DFN=""
Begin DoDot:1
+26 SET GMRCERR="1"
SET GMRCERMS="Not A Valid Consult - File Not Found."
+27 DO EXIT^GMRCGUIA
End DoDot:1
QUIT GMRCERR_"^"_GMRCERMS
+28 DO STATUS^GMRCP
IF $DATA(GMRCQUT)
DO EXIT^GMRCGUIA
QUIT GMRCERR_"^"_GMRCERMS
+29 IF '$ORDER(GMRCMT(0))
DO AUDIT^GMRCP
+30 IF $ORDER(GMRCMT(0))
Begin DoDot:1
+31 SET DA=$$SETDA^GMRCGUIB
+32 SET GMRCMT(0)=DA
SET GMRCMT=1
+33 DO SETCOM^GMRCGUIB(.GMRCMT,GMRCDUZ)
End DoDot:1
+34 DO EN^GMRCHL7(DFN,GMRCO,"","","SC",GMRCORNP,"",.GMRCMT,"",GMRCAD)
+35 ;send alerts
Begin DoDot:1
+36 NEW TXT
+37 SET TXT="Comment Added to Consult "_$$ORTX^GMRCAU(GMRCO)
+38 IF $PIECE(^GMR(123,+GMRCO,0),U,14)
IF $PIECE(^GMR(123,+GMRCO,0),U,14)'=DUZ
SET GMRCADUZ($PIECE(^(0),U,14))=""
+39 DO MSG^GMRCP(DFN,TXT,GMRCO,63,.GMRCADUZ,0)
End DoDot:1
+40 DO EXIT^GMRCGUIA
+41 QUIT GMRCERR_"^"_GMRCERMS
