MAGDHOWS ;WOIFO/PMK,DAC - Capture Consult/GMRC data ;07 Jun 2018 2:35 PM
;;3.0;IMAGING;**138,174,208**;Mar 19, 2002;Build 6
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
; Supported IA #2056 reference $$GET1^DIQ function call
; Supported IA #10103 reference $$HTFN^XLFDT function call
; Supported IA #10103 reference $$NOW^XLFDT function call
; Controlled IA #4110 to read REQUEST/CONSULTATION file (#123)
; Supported IA #10040 to read HOSPITAL LOCATION file (#44)
;
; Called from PROTOCOL called MAGD APPOINTMENT (^ORD(101,...))
; through the scheduling package
;
N %,AFTERSTS,APTSCHED,CLINIC,CONSULTM,CUTOFF,DATETIME
N DFN,FILLER2,FMDATE,FMDATETM
N GMRCIEN,HIT,I,IREQ,MSGTYPE
N ORCTRL,ORSTATUS,SDAMDFN,SENDIT,SERVICE,SS,STATUS,UNKNOWN,X,Y,Z
;
Q:$P($G(SDATA("AFTER","STATUS")),"^",3)="" ; Not a valid appointment
;
;
S FMDATETM=$$NOW^XLFDT(),FMDATE=FMDATETM\1
S CUTOFF=$$HTFM^XLFDT($H-90) ; cutoff date is 90 days ago
S DFN=$P(SDATA,"^",2),DATETIME=$P(SDATA,"^",3),CLINIC=$P(SDATA,"^",4)
S APTSCHED("CLINIC IEN")=CLINIC,APTSCHED("FM DATETIME")=DATETIME
S APTSCHED("CLINIC NAME")=$S(CLINIC:$$GET1^DIQ(44,CLINIC,.01),1:"")
S AFTERSTS=SDATA("AFTER","STATUS"),X=$P(AFTERSTS,"^",3)
; appointment management transactions from ^SD(409.63)
S FILLER2="" D Q:FILLER2=""
. I X["CHECK IN" S FILLER2="SDAM-CHECKIN" Q
. I X["CHECKED IN" S FILLER2="SDAM-CHECKIN" Q
. I X["CHECK OUT" S FILLER2="SDAM-CHECKOUT" Q
. I X["CHECKED OUT" S FILLER2="SDAM-CHECKOUT" Q
. I X["AUTO RE-" S FILLER2="SDAM-SCHEDULED" Q
. I X["AUTO-RE" S FILLER2="SDAM-SCHEDULED" Q
. I X["ACTION REQUIRED" S FILLER2="SDAM-SCHEDULED" Q
. I X["ACT REQ" S FILLER2="SDAM-SCHEDULED" Q
. I X["NON-COUNT" S FILLER2="SDAM-SCHEDULED" Q
. I X["CANCELLED" S FILLER2="SDAM-CANCELLED" Q
. I X["NO-SHOW" S FILLER2="SDAM-CANCELLED" Q
. I X["DELETED" S FILLER2="SDAM-CANCELLED" Q
. I X["FUTURE" S FILLER2="SDAM-FUTURE" Q
. I X["NO ACTION TAKEN" S FILLER2="SDAM-SCHEDULED" Q
. I X["NO ACT TAKN" S FILLER2="SDAM-SCHEDULED" Q
. I X["INPATIENT" S FILLER2="SDAM-SCHEDULED" Q
. ;
. W !!,"Unexpected Status: """,X,""" in protocol MAGD APPOINTMENT."
. W !,"Please notify Customer Support"
. W !!,"Press <Enter> to continue: " R X:$G(DTIME,300)
. Q
;
; find the associated consult or procedure request using SD*5.3*478
S GMRCIEN="" F I=1:1 D Q:GMRCIEN Q:'SDAMDFN
. S SS=I_","_DATETIME_","_CLINIC
. S SDAMDFN=$$GET1^DIQ(44.003,SS,.01,"I")
. I SDAMDFN=DFN S GMRCIEN=$$GET1^DIQ(44.003,SS,688,"I")
. Q
;
I GMRCIEN D ; consult linked to appointment
. N GMRCSTATUS ; P174 DAC - link appointments only to active consults, ignore the rest
. N CPINVOCATION ; P208 PMK 4/18/2018
. I $$CPORDER^MAGDHOWP(GMRCIEN)="2,UNFINISHED" Q ; don't generate HL7 for new CP orders - P208 PMK 4/24/18
. S CPINVOCATION=0 ; Clinical Procedures exam HL7 flag (set to 1 in MAGDHOWP) P208 PMK 4/18/18
. S GMRCSTATUS=$$GET1^DIQ(123,GMRCIEN,8,"E")
. I "^ACTIVE^PENDING^RENEWED^SCHEDULED^"[("^"_GMRCSTATUS_"^") D
. . S SERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
. . D MSGSETUP^MAGDHOW1(GMRCIEN,SERVICE,"XO","SC",.APTSCHED)
. . Q
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDHOWS 4119 printed Oct 16, 2024@18:00:59 Page 2
MAGDHOWS ;WOIFO/PMK,DAC - Capture Consult/GMRC data ;07 Jun 2018 2:35 PM
+1 ;;3.0;IMAGING;**138,174,208**;Mar 19, 2002;Build 6
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ; Supported IA #2056 reference $$GET1^DIQ function call
+18 ; Supported IA #10103 reference $$HTFN^XLFDT function call
+19 ; Supported IA #10103 reference $$NOW^XLFDT function call
+20 ; Controlled IA #4110 to read REQUEST/CONSULTATION file (#123)
+21 ; Supported IA #10040 to read HOSPITAL LOCATION file (#44)
+22 ;
+23 ; Called from PROTOCOL called MAGD APPOINTMENT (^ORD(101,...))
+24 ; through the scheduling package
+25 ;
+26 NEW %,AFTERSTS,APTSCHED,CLINIC,CONSULTM,CUTOFF,DATETIME
+27 NEW DFN,FILLER2,FMDATE,FMDATETM
+28 NEW GMRCIEN,HIT,I,IREQ,MSGTYPE
+29 NEW ORCTRL,ORSTATUS,SDAMDFN,SENDIT,SERVICE,SS,STATUS,UNKNOWN,X,Y,Z
+30 ;
+31 ; Not a valid appointment
if $PIECE($GET(SDATA("AFTER","STATUS")),"^",3)=""
QUIT
+32 ;
+33 ;
+34 SET FMDATETM=$$NOW^XLFDT()
SET FMDATE=FMDATETM\1
+35 ; cutoff date is 90 days ago
SET CUTOFF=$$HTFM^XLFDT($HOROLOG-90)
+36 SET DFN=$PIECE(SDATA,"^",2)
SET DATETIME=$PIECE(SDATA,"^",3)
SET CLINIC=$PIECE(SDATA,"^",4)
+37 SET APTSCHED("CLINIC IEN")=CLINIC
SET APTSCHED("FM DATETIME")=DATETIME
+38 SET APTSCHED("CLINIC NAME")=$SELECT(CLINIC:$$GET1^DIQ(44,CLINIC,.01),1:"")
+39 SET AFTERSTS=SDATA("AFTER","STATUS")
SET X=$PIECE(AFTERSTS,"^",3)
+40 ; appointment management transactions from ^SD(409.63)
+41 SET FILLER2=""
Begin DoDot:1
+42 IF X["CHECK IN"
SET FILLER2="SDAM-CHECKIN"
QUIT
+43 IF X["CHECKED IN"
SET FILLER2="SDAM-CHECKIN"
QUIT
+44 IF X["CHECK OUT"
SET FILLER2="SDAM-CHECKOUT"
QUIT
+45 IF X["CHECKED OUT"
SET FILLER2="SDAM-CHECKOUT"
QUIT
+46 IF X["AUTO RE-"
SET FILLER2="SDAM-SCHEDULED"
QUIT
+47 IF X["AUTO-RE"
SET FILLER2="SDAM-SCHEDULED"
QUIT
+48 IF X["ACTION REQUIRED"
SET FILLER2="SDAM-SCHEDULED"
QUIT
+49 IF X["ACT REQ"
SET FILLER2="SDAM-SCHEDULED"
QUIT
+50 IF X["NON-COUNT"
SET FILLER2="SDAM-SCHEDULED"
QUIT
+51 IF X["CANCELLED"
SET FILLER2="SDAM-CANCELLED"
QUIT
+52 IF X["NO-SHOW"
SET FILLER2="SDAM-CANCELLED"
QUIT
+53 IF X["DELETED"
SET FILLER2="SDAM-CANCELLED"
QUIT
+54 IF X["FUTURE"
SET FILLER2="SDAM-FUTURE"
QUIT
+55 IF X["NO ACTION TAKEN"
SET FILLER2="SDAM-SCHEDULED"
QUIT
+56 IF X["NO ACT TAKN"
SET FILLER2="SDAM-SCHEDULED"
QUIT
+57 IF X["INPATIENT"
SET FILLER2="SDAM-SCHEDULED"
QUIT
+58 ;
+59 WRITE !!,"Unexpected Status: """,X,""" in protocol MAGD APPOINTMENT."
+60 WRITE !,"Please notify Customer Support"
+61 WRITE !!,"Press <Enter> to continue: "
READ X:$GET(DTIME,300)
+62 QUIT
End DoDot:1
if FILLER2=""
QUIT
+63 ;
+64 ; find the associated consult or procedure request using SD*5.3*478
+65 SET GMRCIEN=""
FOR I=1:1
Begin DoDot:1
+66 SET SS=I_","_DATETIME_","_CLINIC
+67 SET SDAMDFN=$$GET1^DIQ(44.003,SS,.01,"I")
+68 IF SDAMDFN=DFN
SET GMRCIEN=$$GET1^DIQ(44.003,SS,688,"I")
+69 QUIT
End DoDot:1
if GMRCIEN
QUIT
if 'SDAMDFN
QUIT
+70 ;
+71 ; consult linked to appointment
IF GMRCIEN
Begin DoDot:1
+72 ; P174 DAC - link appointments only to active consults, ignore the rest
NEW GMRCSTATUS
+73 ; P208 PMK 4/18/2018
NEW CPINVOCATION
+74 ; don't generate HL7 for new CP orders - P208 PMK 4/24/18
IF $$CPORDER^MAGDHOWP(GMRCIEN)="2,UNFINISHED"
QUIT
+75 ; Clinical Procedures exam HL7 flag (set to 1 in MAGDHOWP) P208 PMK 4/18/18
SET CPINVOCATION=0
+76 SET GMRCSTATUS=$$GET1^DIQ(123,GMRCIEN,8,"E")
+77 IF "^ACTIVE^PENDING^RENEWED^SCHEDULED^"[("^"_GMRCSTATUS_"^")
Begin DoDot:2
+78 SET SERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
+79 DO MSGSETUP^MAGDHOW1(GMRCIEN,SERVICE,"XO","SC",.APTSCHED)
+80 QUIT
End DoDot:2
+81 QUIT
End DoDot:1
+82 QUIT
