RG4POST ;HIRMFO/GJC-POST-INIT DRIVER ;11/10/99
;;1.0;CLINICAL INFO RESOURCE NETWORK;**4**;30 Apr 99
;
N RGCHK
S RGCHK=$$NEWCP^XPDUTL("POST1","EN1^RG4POST")
; Add RG ADT ENCOUNTER DRIVER (extended action protocol)
; as an Item under DGPM MOVEMENT EVENTS & SDAM APPOINTMENT
; EVENTS.
;
S RGCHK=$$NEWCP^XPDUTL("POST2","EN2^RG4POST")
; Task off the process (RGADT2) that seeds (adds data to
; a null field) the DATE LAST TREATED (#.03) field and the
; ADT/HL7 EVENT REASON (#.07) field in the TREATING FACILITY
; LIST (#391.91) file. Broadcasts MFU HL7 messages with the
; data mentioned above (VAFCTFMF).
;
S RGCHK=$$NEWCP^XPDUTL("POST4","EN4^RG4POST")
; Add RG CIRN ADT to the HL7 APPLICATION PARAMETER (#.02)
; field for all the entries in the ADT/HL7 EVENT REASON
; (#391.72) file.
;
QUIT
;
EN1 ; Add RG ADT ENCOUNTER DRIVER (extended action protocol) as
; an Item under DGPM MOVEMENT EVENTS & SDAM APPOINTMENT EVENTS
K RGFDA,RGMSG N X0,X1,X2,Y0,Y1,Y2
; CIRN stuff
S Y0="RG ADT ENCOUNTER DRIVER",X0=+$$FIND1^DIC(101,"","QX",Y0)
I X0=0 D ERRMSG(Y0) Q
; PIMS stuff: SDAM APPOINTMENT EVENTS
S Y1="SDAM APPOINTMENT EVENTS",X1=+$$FIND1^DIC(101,"","QX",Y1)
I X1=0 D ERRMSG(Y1) Q
; DGPM MOVEMENT EVENTS
S Y2="DGPM MOVEMENT EVENTS",X2=+$$FIND1^DIC(101,"","QX",Y2)
I X2=0 D ERRMSG(Y2) Q
;
; add RG ADT ENCOUNTER DRIVER as an item under SDAM APPOINTMENT EVENTS
S RGFDA(101.01,"+1,"_X1_",",.01)=Y0
D:'$D(^ORD(101,X1,10,"B",X0)) UPDATE^DIE("E","RGFDA")
I '$D(^ORD(101,X1,10,"B",X0)) D ; issue error message
. K RGMSG S RGMSG(1)=" ",RGMSG(2)="Error adding "_Y0_" as an"
. S RGMSG(3)="item under "_Y1 D MES^XPDUTL(.RGMSG)
. Q
; add RG ADT ENCOUNTER DRIVER as an item under DGPM MOVEMENT EVENTS
S RGFDA(101.01,"+1,"_X2_",",.01)=Y0
D:'$D(^ORD(101,X2,10,"B",X0)) UPDATE^DIE("E","RGFDA")
I '$D(^ORD(101,X2,10,"B",X0)) D ; issue error message
. K RGMSG S RGMSG(1)=" ",RGMSG(2)="Error adding "_Y0_" as an"
. S RGMSG(3)="item under "_Y2 D MES^XPDUTL(.RGMSG)
. Q
K RGFDA,RGMSG
QUIT
;
EN2 ; Task off the process (RGADT2) that seeds (adds data to a null
; field) the DATE LAST TREATED (#.03) field in the TREATING FACILITY
; LIST (#391.91) file. Admission and discharge dates are checked on
; the registration side (IN5^VADPT), and a status of 'check out' is
; what our software is looking for in the OUTPATIENT ENCOUNTER
; (#409.68) file.
;
Q:'$D(^DPT("AICN")) ; if MPI has not been loaded, quit
Q:$P($G(^RGSITE(991.8,1,1)),"^",2) ; seeding process ran in the past
K RGMSG N ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
S ZTIO="",ZTRTN="EN^RGADT2",ZTDESC="CIRN-CPRS: seed DATE LAST TREATED field (TREATING FACILITY LIST #391.91)"
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,1,0) ; in future, one minute
S:$D(XPDNM) ZTSAVE("XPD*")=""
S:$D(RGDUZ) ZTSAVE("RGDUZ")=""
D ^%ZTLOAD
S RGMSG(1)=" ",RGMSG(2)="CIRN-CPRS: DATE LAST TREATED field seeding for the TREATING FACILITY"
S RGMSG(3)="LIST (#391.91) file is running in background."
S:$G(ZTSK)>0 RGMSG(4)="Task: "_ZTSK_"." D MES^XPDUTL(.RGMSG)
K RGMSG,RGDUZ
QUIT
;
EN4 ; Add RG CIRN ADT to the HL7 APPLICATION PARAMETER (#.02)
; field for all the entries in the ADT/HL7 EVENT REASON
; (#391.72) file.
N RG771 S RG771=+$$FIND1^DIC(771,"","X","RG CIRN ADT")
Q:'RG771 N DA,RGFDA ; quit if RG CIRN ADT cannot be found
S DA=0 F S DA=$O(^VAT(391.72,DA)) Q:'DA D
.S RGFDA(391.72,DA_",",.02)=RG771
.D FILE^DIE("K","RGFDA") K RGFDA
Q
;
ERRMSG(X) ; display an error message about missing protocols
; input: the name of the protocol missing
K RGMSG S RGMSG(1)=" ",RGMSG(2)=X_" protocol is missing"
S RGMSG(3)="from the host system. Contact your "_$S($E(X,1,2)="RG":"CIRN",1:"PIMS")_" ADPAC."
D MES^XPDUTL(.RGMSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRG4POST 3882 printed Nov 22, 2024@16:51:29 Page 2
RG4POST ;HIRMFO/GJC-POST-INIT DRIVER ;11/10/99
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**4**;30 Apr 99
+2 ;
+3 NEW RGCHK
+4 SET RGCHK=$$NEWCP^XPDUTL("POST1","EN1^RG4POST")
+5 ; Add RG ADT ENCOUNTER DRIVER (extended action protocol)
+6 ; as an Item under DGPM MOVEMENT EVENTS & SDAM APPOINTMENT
+7 ; EVENTS.
+8 ;
+9 SET RGCHK=$$NEWCP^XPDUTL("POST2","EN2^RG4POST")
+10 ; Task off the process (RGADT2) that seeds (adds data to
+11 ; a null field) the DATE LAST TREATED (#.03) field and the
+12 ; ADT/HL7 EVENT REASON (#.07) field in the TREATING FACILITY
+13 ; LIST (#391.91) file. Broadcasts MFU HL7 messages with the
+14 ; data mentioned above (VAFCTFMF).
+15 ;
+16 SET RGCHK=$$NEWCP^XPDUTL("POST4","EN4^RG4POST")
+17 ; Add RG CIRN ADT to the HL7 APPLICATION PARAMETER (#.02)
+18 ; field for all the entries in the ADT/HL7 EVENT REASON
+19 ; (#391.72) file.
+20 ;
+21 QUIT
+22 ;
EN1 ; Add RG ADT ENCOUNTER DRIVER (extended action protocol) as
+1 ; an Item under DGPM MOVEMENT EVENTS & SDAM APPOINTMENT EVENTS
+2 KILL RGFDA,RGMSG
NEW X0,X1,X2,Y0,Y1,Y2
+3 ; CIRN stuff
+4 SET Y0="RG ADT ENCOUNTER DRIVER"
SET X0=+$$FIND1^DIC(101,"","QX",Y0)
+5 IF X0=0
DO ERRMSG(Y0)
QUIT
+6 ; PIMS stuff: SDAM APPOINTMENT EVENTS
+7 SET Y1="SDAM APPOINTMENT EVENTS"
SET X1=+$$FIND1^DIC(101,"","QX",Y1)
+8 IF X1=0
DO ERRMSG(Y1)
QUIT
+9 ; DGPM MOVEMENT EVENTS
+10 SET Y2="DGPM MOVEMENT EVENTS"
SET X2=+$$FIND1^DIC(101,"","QX",Y2)
+11 IF X2=0
DO ERRMSG(Y2)
QUIT
+12 ;
+13 ; add RG ADT ENCOUNTER DRIVER as an item under SDAM APPOINTMENT EVENTS
+14 SET RGFDA(101.01,"+1,"_X1_",",.01)=Y0
+15 if '$DATA(^ORD(101,X1,10,"B",X0))
DO UPDATE^DIE("E","RGFDA")
+16 ; issue error message
IF '$DATA(^ORD(101,X1,10,"B",X0))
Begin DoDot:1
+17 KILL RGMSG
SET RGMSG(1)=" "
SET RGMSG(2)="Error adding "_Y0_" as an"
+18 SET RGMSG(3)="item under "_Y1
DO MES^XPDUTL(.RGMSG)
+19 QUIT
End DoDot:1
+20 ; add RG ADT ENCOUNTER DRIVER as an item under DGPM MOVEMENT EVENTS
+21 SET RGFDA(101.01,"+1,"_X2_",",.01)=Y0
+22 if '$DATA(^ORD(101,X2,10,"B",X0))
DO UPDATE^DIE("E","RGFDA")
+23 ; issue error message
IF '$DATA(^ORD(101,X2,10,"B",X0))
Begin DoDot:1
+24 KILL RGMSG
SET RGMSG(1)=" "
SET RGMSG(2)="Error adding "_Y0_" as an"
+25 SET RGMSG(3)="item under "_Y2
DO MES^XPDUTL(.RGMSG)
+26 QUIT
End DoDot:1
+27 KILL RGFDA,RGMSG
+28 QUIT
+29 ;
EN2 ; Task off the process (RGADT2) that seeds (adds data to a null
+1 ; field) the DATE LAST TREATED (#.03) field in the TREATING FACILITY
+2 ; LIST (#391.91) file. Admission and discharge dates are checked on
+3 ; the registration side (IN5^VADPT), and a status of 'check out' is
+4 ; what our software is looking for in the OUTPATIENT ENCOUNTER
+5 ; (#409.68) file.
+6 ;
+7 ; if MPI has not been loaded, quit
if '$DATA(^DPT("AICN"))
QUIT
+8 ; seeding process ran in the past
if $PIECE($GET(^RGSITE(991.8,1,1)),"^",2)
QUIT
+9 KILL RGMSG
NEW ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+10 SET ZTIO=""
SET ZTRTN="EN^RGADT2"
SET ZTDESC="CIRN-CPRS: seed DATE LAST TREATED field (TREATING FACILITY LIST #391.91)"
+11 ; in future, one minute
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),0,0,1,0)
+12 if $DATA(XPDNM)
SET ZTSAVE("XPD*")=""
+13 if $DATA(RGDUZ)
SET ZTSAVE("RGDUZ")=""
+14 DO ^%ZTLOAD
+15 SET RGMSG(1)=" "
SET RGMSG(2)="CIRN-CPRS: DATE LAST TREATED field seeding for the TREATING FACILITY"
+16 SET RGMSG(3)="LIST (#391.91) file is running in background."
+17 if $GET(ZTSK)>0
SET RGMSG(4)="Task: "_ZTSK_"."
DO MES^XPDUTL(.RGMSG)
+18 KILL RGMSG,RGDUZ
+19 QUIT
+20 ;
EN4 ; Add RG CIRN ADT to the HL7 APPLICATION PARAMETER (#.02)
+1 ; field for all the entries in the ADT/HL7 EVENT REASON
+2 ; (#391.72) file.
+3 NEW RG771
SET RG771=+$$FIND1^DIC(771,"","X","RG CIRN ADT")
+4 ; quit if RG CIRN ADT cannot be found
if 'RG771
QUIT
NEW DA,RGFDA
+5 SET DA=0
FOR
SET DA=$ORDER(^VAT(391.72,DA))
if 'DA
QUIT
Begin DoDot:1
+6 SET RGFDA(391.72,DA_",",.02)=RG771
+7 DO FILE^DIE("K","RGFDA")
KILL RGFDA
End DoDot:1
+8 QUIT
+9 ;
ERRMSG(X) ; display an error message about missing protocols
+1 ; input: the name of the protocol missing
+2 KILL RGMSG
SET RGMSG(1)=" "
SET RGMSG(2)=X_" protocol is missing"
+3 SET RGMSG(3)="from the host system. Contact your "_$SELECT($EXTRACT(X,1,2)="RG":"CIRN",1:"PIMS")_" ADPAC."
+4 DO MES^XPDUTL(.RGMSG)
+5 QUIT
