- MDHL7XXX ; HOIFO/DP - Loopback device for CP ;4/10/09 09:20
- ;;1.0;CLINICAL PROCEDURES;**21,34,73**;Apr 01, 2004;Build 2
- ; 06/05/19 KAM/BP S/N Ticket INC5256127/MD*1*73 Modified the Process
- ; subroutine to no longer send an alert when it encounters a
- ; 'RETRACTED' note
- ; 06/19/13 KAM/BP Remedy Ticket 442635/MD*1*34 Modified the Process
- ; subroutine to look back 365 days instead of 5 days for
- ; auto-complete of procedures
- ; IA# 2263 [Supported] XPAR Call
- ; 2693 [Subscription] TIU Extractions.
- ; 2980 [Subscription] Calls to GMRCGUIB.
- ; 3160 [Subscription] GMRCMED Call
- ; 3067 [Private] Read fields in Consult file (#123) w/FM
- ; 3468 [Subscription] GMRCCP API.
- ; 3535 [Subscription] Calls to TIUSRVP.
- ; 4508 [Subscription] Call to TIUSRVPT.
- ; 10060 [Supported] New Person File (#200) Read w/FM.
- ; 10103 [Supported] Calls to XLFDT
- ;
- EN ; [Procedure] Main entry point
- ; wait 10 seconds and then produce some results in the CP RESULTS file
- ; Variables STUDY and INST passed in via taskman
- H 10 ; Wait for the study to update
- N MDFDA,MDIEN,MDERR K ^TMP($J)
- L +(^MDD(703.1,"B")):15 E Q
- F D Q:'$D(^MDD(703.1,"B",X))
- .S X="127001_"_(+$H)_$E($P($H,",",2)_"00000",1,5)
- S MDFDA(703.1,"+1,",.01)=X
- D UPDATE^DIE("","MDFDA","MDIEN","MDERR")
- L -(^MDD(703.1,"B"))
- S MDIEN=+$G(MDIEN(1),-1)_"," Q:+MDIEN<0
- ; Proceed to build the report here using MDIEN in file 703.1
- S MDFDA(703.1,MDIEN,.02)=$P(^MDD(702,STUDY,0),U,1)
- S MDFDA(703.1,MDIEN,.03)=$$NOW^XLFDT()
- S MDFDA(703.1,MDIEN,.04)=INST
- D:+$$GET1^DIQ(702.09,INST_",",.13,"I") ; Bi-Directional?
- .S MDFDA(703.1,MDIEN,.05)=STUDY
- ;
- ;; New Loopback Method -- BEGIN
- S MDFDA(703.1,MDIEN,.09)="P"
- S MDFDA(703.11,"+2,"_MDIEN,.01)="3"
- S MDFDA(703.11,"+2,"_MDIEN,.1)="\\vhaishmul14\uploads\body-box-study_19960228_000.pdf"
- D UPDATE^DIE("","MDFDA","MDIEN","MDERR")
- ;; New Loopback Method -- END
- ;
- ; New High Volume Procedure code begin
- N MDSR S MDSR=$$NTIU^MDRPCW1(+STUDY,+MDIEN)
- ; New High Volume Procedure end
- ;; Original Loopback Method -- BEGIN
- ;S MDFDA(703.11,"+2,"_MDIEN,.01)="1"
- ;D UPDATE^DIE("","MDFDA","MDIEN","MDERR")
- ;S MDIEN=+MDIEN(2)_","_MDIEN
- ;S MDFDA(703.11,MDIEN,.2)=$NA(MDFDA(703.11,MDIEN,.2))
- ;D GETS^DIQ(702,STUDY_",",".01;.011;.02;.03;.04;.05;.06;.07;.08;.09;.091;.1;.11;.12;.991","ENR",$NA(^TMP($J)))
- ;S X="" F S X=$O(^TMP($J,702,STUDY_",",X)) Q:X="" D
- ;.S Y=$O(MDFDA(703.11,MDIEN,.2,""),-1)+1
- ;.S MDFDA(703.11,MDIEN,.2,Y)=X_": "_$G(^TMP($J,702,STUDY_",",X,"E"))
- ;S MDFDA(703.1,$P(MDIEN,",",2,3),.09)="P"
- ;D UPDATE^DIE("","MDFDA","MDIEN","MDERR")
- ;; Original Loopback Method -- END
- ;
- K ^TMP($J)
- Q
- ;
- TEST ; Queue up the study creator
- N DIC
- S DIC=702,DIC(0)="AEQM",DIC("A")="Select Study to create a report for: "
- D ^DIC Q:+Y<1
- S STUDY=+Y,INST=+$P(^MDD(702,+Y,0),U,11)
- D LOOPBACK(STUDY,INST)
- Q
- ;
- LOOPBACK(STUDY,INST) ; Queue up the Loopback process
- N ZTSAVE,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK
- S ZTSAVE("STUDY")=STUDY,ZTSAVE("INST")=INST
- S ZTRTN="EN^MDHL7XXX"
- S ZTIO=""
- S ZTDESC="CP Loopback test"
- S ZTDTH=$$NOW^XLFDT()
- D ^%ZTLOAD
- Q
- PROCESS ; Process Device Results
- N MDADD,MDADAR,MDARAD,MDWA,MDALRT,MDAPU,MDCONRS,MDCST,MDCX,MDFD,MDFDA,MDL,MDL1,MDHR,MDHVL,MDKK,MDMAXD,MDMG,MDRR,MDSTU,MDSTAT,MDTIUER,MDX,MDX4
- S MDMAXD=DT+.24,(MDRR,MDARAD,MDTIUER)="" K ^TMP("MDTIUST",$J)
- D GETLST^XPAR(.MDHVL,"SYS","MD GET HIGH VOLUME")
- S MDAPU="CLINICAL,DEVICE PROXY SERVICE"
- S MDFD=$$FIND1^DIC(200,,"X",MDAPU,"B")
- F MDKK=0:0 S MDKK=$O(MDHVL(MDKK)) Q:MDKK<1 S:+$P($G(MDHVL(MDKK)),"^") MDHR(+$P($G(MDHVL(MDKK)),"^"))=$P($G(MDHVL(MDKK)),"^",2)
- ;
- ;06/19/13 KAM/BP 442635/MD*1*34 Changed next line from -5 to -365
- ;
- S MDL=$$FMADD^XLFDT(DT,-365,0,0) F S MDL=$O(^MDD(702,"ASD",MDL)) Q:MDL<1!(MDL>MDMAXD) F MDL1=0:0 S MDL1=$O(^MDD(702,"ASD",MDL,MDL1)) Q:MDL1<1 S MDX=$G(^MDD(702,MDL1,0)) D
- .Q:$G(MDHR(+$P(MDX,"^",4)))="" S MDCX=$G(MDHR(+$P(MDX,"^",4)))
- .Q:$P($G(^MDS(702.01,+$P(MDX,U,4),0)),U,6)=2
- .S MDCST=$P(MDX,"^",5) Q:'+MDCST
- .Q:'+$P(MDX,"^",6)
- .K ^TMP("MDTIUST",$J),MDWA
- .S MDWA(1202)=MDFD,MDWA(1204)=MDFD,MDWA(1302)=MDFD
- .S MDWA("TEXT",1,0)="** DOCUMENT IN VISTA IMAGING **"
- .S MDWA("TEXT",2,0)="SEE FULL REPORT IN VISTA IMAGING",MDWA("TEXT",3,0)=""
- .D EXTRACT^TIULQ($P(MDX,U,6),"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05","E")
- .I $G(^TMP("MDTIUST",$J,$P(MDX,U,6),.05,"E"))'="COMPLETED"&('+$P(MDCX,";",2)) D Q
- ..Q:$P(MDX,"^",9)'=3
- ..Q:$G(^TMP("MDTIUST",$J,$P(MDX,U,6),.05,"E"))="RETRACTED" ;MD*1*73
- ..I +$P(MDCX,";",1) S MDCONRS=$$CPDOC^GMRCCP(+MDCST,+$P(MDX,"^",6),2) Q
- ..I '+$P(MDCX,";",1) D UPDATE^TIUSRVP(.MDRR,+$P(MDX,"^",6),.MDWA,1) D:+MDRR'<1 ADMNCLOS^TIUSRVPT(.MDARAD,+$P(MDX,"^",6),"M",MDFD) K MDWA D MEDCOMP^GMRCMED(+MDCST,$P(MDX,"^",6)_";TIU(8925,",DT,MDFD,$P(MDX,"^",3))
- ..Q
- .S MDSTU=MDL1 K MDWA
- .S MDSTAT=$$GET1^DIQ(123,+MDCST_",",8,"E") I MDSTAT="COMPLETE" Q:$P(MDX,"^",9)=3 K MDFDA S MDFDA(702,MDSTU_",",.09)=3 D FILE^DIE("","MDFDA") K MDFDA Q
- .I +$P(MDCX,";",2) D Q
- ..D GID(MDSTU,.MDADAR)
- ..Q:$G(MDADAR(1))=""
- ..S MDADD=$$SFILE^GMRCGUIB(+MDCST,4,"Y",MDFD,MDFD,.MDADAR,"N","",$G(^MDD(702,+MDSTU,3)))
- ..S MDCONRS=$$CPDOC^GMRCCP(+MDCST,+$P(MDX,"^",6),2) Q
- .S MDGET=$O(^MDD(703.1,"ASTUDYID",MDL1,""),-1) Q:'MDGET S MDDAT=$P($G(^MDD(703.1,MDGET,0)),"^",3)
- .D MEDCOMP^GMRCMED(+MDCST,$P(MDX,"^",6)_";TIU(8925,",MDDAT,MDFD,$P(MDX,"^",3))
- .K ^TMP("MDTIUST",$J)
- .I $P(MDX,"^",9)'=3 K MDFDA S MDFDA(702,MDSTU_",",.09)=3 D FILE^DIE("","MDFDA") K MDFDA
- Q
- GID(STU,MDARY) ; Get the text array
- N LOOP,MDRID,NODE S MDRID=0,LOOP=""
- F S LOOP=$O(^MDD(703.1,"ASTUDYID",STU,LOOP),-1) Q:LOOP<1!(+MDRID) I +$P($G(^MDD(703.1,+LOOP,.4,0)),"^",3) S MDRID=+LOOP,NODE=$$GET1^DIQ(703.1,MDRID_",",.4,"","MDARY")
- I +MDRID K MDFDA S MDFDA(703.1,MDRID_",",.4)="@" D FILE^DIE("","MDFDA") K MDFDA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMDHL7XXX 5939 printed Apr 23, 2025@17:57:26 Page 2
- MDHL7XXX ; HOIFO/DP - Loopback device for CP ;4/10/09 09:20
- +1 ;;1.0;CLINICAL PROCEDURES;**21,34,73**;Apr 01, 2004;Build 2
- +2 ; 06/05/19 KAM/BP S/N Ticket INC5256127/MD*1*73 Modified the Process
- +3 ; subroutine to no longer send an alert when it encounters a
- +4 ; 'RETRACTED' note
- +5 ; 06/19/13 KAM/BP Remedy Ticket 442635/MD*1*34 Modified the Process
- +6 ; subroutine to look back 365 days instead of 5 days for
- +7 ; auto-complete of procedures
- +8 ; IA# 2263 [Supported] XPAR Call
- +9 ; 2693 [Subscription] TIU Extractions.
- +10 ; 2980 [Subscription] Calls to GMRCGUIB.
- +11 ; 3160 [Subscription] GMRCMED Call
- +12 ; 3067 [Private] Read fields in Consult file (#123) w/FM
- +13 ; 3468 [Subscription] GMRCCP API.
- +14 ; 3535 [Subscription] Calls to TIUSRVP.
- +15 ; 4508 [Subscription] Call to TIUSRVPT.
- +16 ; 10060 [Supported] New Person File (#200) Read w/FM.
- +17 ; 10103 [Supported] Calls to XLFDT
- +18 ;
- EN ; [Procedure] Main entry point
- +1 ; wait 10 seconds and then produce some results in the CP RESULTS file
- +2 ; Variables STUDY and INST passed in via taskman
- +3 ; Wait for the study to update
- HANG 10
- +4 NEW MDFDA,MDIEN,MDERR
- KILL ^TMP($JOB)
- +5 LOCK +(^MDD(703.1,"B")):15
- IF '$TEST
- QUIT
- +6 FOR
- Begin DoDot:1
- +7 SET X="127001_"_(+$HOROLOG)_$EXTRACT($PIECE($HOROLOG,",",2)_"00000",1,5)
- End DoDot:1
- if '$DATA(^MDD(703.1,"B",X))
- QUIT
- +8 SET MDFDA(703.1,"+1,",.01)=X
- +9 DO UPDATE^DIE("","MDFDA","MDIEN","MDERR")
- +10 LOCK -(^MDD(703.1,"B"))
- +11 SET MDIEN=+$GET(MDIEN(1),-1)_","
- if +MDIEN<0
- QUIT
- +12 ; Proceed to build the report here using MDIEN in file 703.1
- +13 SET MDFDA(703.1,MDIEN,.02)=$PIECE(^MDD(702,STUDY,0),U,1)
- +14 SET MDFDA(703.1,MDIEN,.03)=$$NOW^XLFDT()
- +15 SET MDFDA(703.1,MDIEN,.04)=INST
- +16 ; Bi-Directional?
- if +$$GET1^DIQ(702.09,INST_",",.13,"I")
- Begin DoDot:1
- +17 SET MDFDA(703.1,MDIEN,.05)=STUDY
- End DoDot:1
- +18 ;
- +19 ;; New Loopback Method -- BEGIN
- +20 SET MDFDA(703.1,MDIEN,.09)="P"
- +21 SET MDFDA(703.11,"+2,"_MDIEN,.01)="3"
- +22 SET MDFDA(703.11,"+2,"_MDIEN,.1)="\\vhaishmul14\uploads\body-box-study_19960228_000.pdf"
- +23 DO UPDATE^DIE("","MDFDA","MDIEN","MDERR")
- +24 ;; New Loopback Method -- END
- +25 ;
- +26 ; New High Volume Procedure code begin
- +27 NEW MDSR
- SET MDSR=$$NTIU^MDRPCW1(+STUDY,+MDIEN)
- +28 ; New High Volume Procedure end
- +29 ;; Original Loopback Method -- BEGIN
- +30 ;S MDFDA(703.11,"+2,"_MDIEN,.01)="1"
- +31 ;D UPDATE^DIE("","MDFDA","MDIEN","MDERR")
- +32 ;S MDIEN=+MDIEN(2)_","_MDIEN
- +33 ;S MDFDA(703.11,MDIEN,.2)=$NA(MDFDA(703.11,MDIEN,.2))
- +34 ;D GETS^DIQ(702,STUDY_",",".01;.011;.02;.03;.04;.05;.06;.07;.08;.09;.091;.1;.11;.12;.991","ENR",$NA(^TMP($J)))
- +35 ;S X="" F S X=$O(^TMP($J,702,STUDY_",",X)) Q:X="" D
- +36 ;.S Y=$O(MDFDA(703.11,MDIEN,.2,""),-1)+1
- +37 ;.S MDFDA(703.11,MDIEN,.2,Y)=X_": "_$G(^TMP($J,702,STUDY_",",X,"E"))
- +38 ;S MDFDA(703.1,$P(MDIEN,",",2,3),.09)="P"
- +39 ;D UPDATE^DIE("","MDFDA","MDIEN","MDERR")
- +40 ;; Original Loopback Method -- END
- +41 ;
- +42 KILL ^TMP($JOB)
- +43 QUIT
- +44 ;
- TEST ; Queue up the study creator
- +1 NEW DIC
- +2 SET DIC=702
- SET DIC(0)="AEQM"
- SET DIC("A")="Select Study to create a report for: "
- +3 DO ^DIC
- if +Y<1
- QUIT
- +4 SET STUDY=+Y
- SET INST=+$PIECE(^MDD(702,+Y,0),U,11)
- +5 DO LOOPBACK(STUDY,INST)
- +6 QUIT
- +7 ;
- LOOPBACK(STUDY,INST) ; Queue up the Loopback process
- +1 NEW ZTSAVE,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK
- +2 SET ZTSAVE("STUDY")=STUDY
- SET ZTSAVE("INST")=INST
- +3 SET ZTRTN="EN^MDHL7XXX"
- +4 SET ZTIO=""
- +5 SET ZTDESC="CP Loopback test"
- +6 SET ZTDTH=$$NOW^XLFDT()
- +7 DO ^%ZTLOAD
- +8 QUIT
- PROCESS ; Process Device Results
- +1 NEW MDADD,MDADAR,MDARAD,MDWA,MDALRT,MDAPU,MDCONRS,MDCST,MDCX,MDFD,MDFDA,MDL,MDL1,MDHR,MDHVL,MDKK,MDMAXD,MDMG,MDRR,MDSTU,MDSTAT,MDTIUER,MDX,MDX4
- +2 SET MDMAXD=DT+.24
- SET (MDRR,MDARAD,MDTIUER)=""
- KILL ^TMP("MDTIUST",$JOB)
- +3 DO GETLST^XPAR(.MDHVL,"SYS","MD GET HIGH VOLUME")
- +4 SET MDAPU="CLINICAL,DEVICE PROXY SERVICE"
- +5 SET MDFD=$$FIND1^DIC(200,,"X",MDAPU,"B")
- +6 FOR MDKK=0:0
- SET MDKK=$ORDER(MDHVL(MDKK))
- if MDKK<1
- QUIT
- if +$PIECE($GET(MDHVL(MDKK)),"^")
- SET MDHR(+$PIECE($GET(MDHVL(MDKK)),"^"))=$PIECE($GET(MDHVL(MDKK)),"^",2)
- +7 ;
- +8 ;06/19/13 KAM/BP 442635/MD*1*34 Changed next line from -5 to -365
- +9 ;
- +10 SET MDL=$$FMADD^XLFDT(DT,-365,0,0)
- FOR
- SET MDL=$ORDER(^MDD(702,"ASD",MDL))
- if MDL<1!(MDL>MDMAXD)
- QUIT
- FOR MDL1=0:0
- SET MDL1=$ORDER(^MDD(702,"ASD",MDL,MDL1))
- if MDL1<1
- QUIT
- SET MDX=$GET(^MDD(702,MDL1,0))
- Begin DoDot:1
- +11 if $GET(MDHR(+$PIECE(MDX,"^",4)))=""
- QUIT
- SET MDCX=$GET(MDHR(+$PIECE(MDX,"^",4)))
- +12 if $PIECE($GET(^MDS(702.01,+$PIECE(MDX,U,4),0)),U,6)=2
- QUIT
- +13 SET MDCST=$PIECE(MDX,"^",5)
- if '+MDCST
- QUIT
- +14 if '+$PIECE(MDX,"^",6)
- QUIT
- +15 KILL ^TMP("MDTIUST",$JOB),MDWA
- +16 SET MDWA(1202)=MDFD
- SET MDWA(1204)=MDFD
- SET MDWA(1302)=MDFD
- +17 SET MDWA("TEXT",1,0)="** DOCUMENT IN VISTA IMAGING **"
- +18 SET MDWA("TEXT",2,0)="SEE FULL REPORT IN VISTA IMAGING"
- SET MDWA("TEXT",3,0)=""
- +19 DO EXTRACT^TIULQ($PIECE(MDX,U,6),"^TMP(""MDTIUST"",$J)",MDTIUER,".01;.05","E")
- +20 IF $GET(^TMP("MDTIUST",$JOB,$PIECE(MDX,U,6),.05,"E"))'="COMPLETED"&('+$PIECE(MDCX,";",2))
- Begin DoDot:2
- +21 if $PIECE(MDX,"^",9)'=3
- QUIT
- +22 ;MD*1*73
- if $GET(^TMP("MDTIUST",$JOB,$PIECE(MDX,U,6),.05,"E"))="RETRACTED"
- QUIT
- +23 IF +$PIECE(MDCX,";",1)
- SET MDCONRS=$$CPDOC^GMRCCP(+MDCST,+$PIECE(MDX,"^",6),2)
- QUIT
- +24 IF '+$PIECE(MDCX,";",1)
- DO UPDATE^TIUSRVP(.MDRR,+$PIECE(MDX,"^",6),.MDWA,1)
- if +MDRR'<1
- DO ADMNCLOS^TIUSRVPT(.MDARAD,+$PIECE(MDX,"^",6),"M",MDFD)
- KILL MDWA
- DO MEDCOMP^GMRCMED(+MDCST,$PIECE(MDX,"^",6)_";TIU(8925,",DT,MDFD,$PIECE(MDX,"^",3))
- +25 QUIT
- End DoDot:2
- QUIT
- +26 SET MDSTU=MDL1
- KILL MDWA
- +27 SET MDSTAT=$$GET1^DIQ(123,+MDCST_",",8,"E")
- IF MDSTAT="COMPLETE"
- if $PIECE(MDX,"^",9)=3
- QUIT
- KILL MDFDA
- SET MDFDA(702,MDSTU_",",.09)=3
- DO FILE^DIE("","MDFDA")
- KILL MDFDA
- QUIT
- +28 IF +$PIECE(MDCX,";",2)
- Begin DoDot:2
- +29 DO GID(MDSTU,.MDADAR)
- +30 if $GET(MDADAR(1))=""
- QUIT
- +31 SET MDADD=$$SFILE^GMRCGUIB(+MDCST,4,"Y",MDFD,MDFD,.MDADAR,"N","",$GET(^MDD(702,+MDSTU,3)))
- +32 SET MDCONRS=$$CPDOC^GMRCCP(+MDCST,+$PIECE(MDX,"^",6),2)
- QUIT
- End DoDot:2
- QUIT
- +33 SET MDGET=$ORDER(^MDD(703.1,"ASTUDYID",MDL1,""),-1)
- if 'MDGET
- QUIT
- SET MDDAT=$PIECE($GET(^MDD(703.1,MDGET,0)),"^",3)
- +34 DO MEDCOMP^GMRCMED(+MDCST,$PIECE(MDX,"^",6)_";TIU(8925,",MDDAT,MDFD,$PIECE(MDX,"^",3))
- +35 KILL ^TMP("MDTIUST",$JOB)
- +36 IF $PIECE(MDX,"^",9)'=3
- KILL MDFDA
- SET MDFDA(702,MDSTU_",",.09)=3
- DO FILE^DIE("","MDFDA")
- KILL MDFDA
- End DoDot:1
- +37 QUIT
- GID(STU,MDARY) ; Get the text array
- +1 NEW LOOP,MDRID,NODE
- SET MDRID=0
- SET LOOP=""
- +2 FOR
- SET LOOP=$ORDER(^MDD(703.1,"ASTUDYID",STU,LOOP),-1)
- if LOOP<1!(+MDRID)
- QUIT
- IF +$PIECE($GET(^MDD(703.1,+LOOP,.4,0)),"^",3)
- SET MDRID=+LOOP
- SET NODE=$$GET1^DIQ(703.1,MDRID_",",.4,"","MDARY")
- +3 IF +MDRID
- KILL MDFDA
- SET MDFDA(703.1,MDRID_",",.4)="@"
- DO FILE^DIE("","MDFDA")
- KILL MDFDA
- +4 QUIT
