XDRRMRG2 ;SF-IRMFO/GB,JLI - GET PATIENT HEALTH SUMMARY ;06/26/98 13:35 [ 04/02/2003 8:47 AM ]
;;7.3;TOOLKIT;**23,29,1001,1003**;Apr 03, 1995
;IHS/OIT/LJF 07/27/2006 PATCH 1003 use IHS merge type as default HS
; PATCH 1003 change default on using browser to NO
;;
ASK(QLIST,ABORT) ; Report-specific questions
N DIC,Y,DTOUT,DUOUT
; Which patient?
; S DIC="^SPNL(154,"
; S DIC("S")="I $P(^(0),U,3)=""A""" ; Select only from active patients
; S DIC(0)="AEQM"
; S DIC("A")="Select SCD Patient: "
; S DIC("?")="Select the patient for whom you want the Health Summary"
; D ^DIC I $D(DTOUT)!($D(DUOUT))!(Y<0) S ABORT=1 Q
; S QLIST("DFN")=+Y ; IEN's are DINUM'd to the ^DPT
K DIC
; Which Health Summary Type?
S DIC="^GMT(142,"
S DIC(0)="AEQM"
;
I $$GET^XPAR("PKG","BPM USE IHS LOGIC") S DIC("B")="BPM MERGE" ;IHS/OIT/LJF 07/27/2006 PATCH 1003 added default
;
S DIC("A")="Select Health Summary Type Name: "
;S DIC("?")="Choose one, if you aren't sure, experiment!"
D ^DIC I $D(DTOUT)!($D(DUOUT))!(Y<0) S ABORT=1 Q
S QLIST("TYPE")=+Y
ASKX Q
;
GATHER(DFN,FDATE,TDATE,HIUSERS,QLIST) ; No need to gather
Q
;
PRINT(QLIST) ;Call to print health summary
D ENX^GMTSDVR(QLIST("DFN"),QLIST("TYPE"))
PRINTX Q
;
PRINT2 ;Prints the record pair using the Browser of to a device.
N XDRIOP
W ! S DIR(0)="Y",DIR("A",1)="Would you like to use the FM Browser to"
S DIR("A")="view the record pair"
S DIR("B")="YES",DIR("?")="You may use FM Browser to view the record pair else you will be prompted to select a device for each record."
;
;IHS/OIT/LJF 07/27/2006 PATCH 1003 changed default to NO
I $$GET^XPAR("PKG","BPM USE IHS LOGIC") S DIR("B")="NO"
;
D ^DIR S:Y=1 XDRIOP=1 Q:$D(DIRUT)
K ^TMP("XDRRMRG1",$J),^TMP("XDRRMRG",$J)
;S IOP="XDRBROWSER1" D ^%ZIS Q:POP ;Old code, delete after testing
REC1 S:$D(XDRIOP) IOP="XDRBROWSER1" S:'$D(XDRIOP) %ZIS="QM"
S %ZIS("A")="DEVICE FOR FIRST RECORD: "
W ! D ^%ZIS Q:POP
I $D(IO("Q")) D G REC2 ;Will queue to TaskMan
. S ZTRTN="QUEUE^XDRRMRG2",ZTIO=ION,ZTDESC="XDR Health Summary for first patient."
. S DFN=DFNFRX,TYPE=QLIST("TYPE"),ZTSAVE("DFN")="",ZTSAVE("TYPE")=""
. D ^%ZTLOAD W:$D(ZTSK) !!,"Queued as task "_ZTSK,!
. Q
U IO(0) W:$D(XDRIOP) " Getting first entry ",!
D ENX^GMTSDVR(DFNFRX,QLIST("TYPE"))
U IO D ^%ZISC
S ^TMP("XDRRMRG",$J,"ENTER <PF1>S TO VIEW OTHER- "_$E($G(DFNFR(1)),1,30)_" "_$G(DFNFR(2))_" ("_DFNFRX_")")="^TMP(""XDRRMRG1"",$J,1)"
M ^TMP("XDRRMRG1",$J,1)=^TMP("DDB",$J)
;S IOP="XDRBROWSER1" D ^%ZIS Q:POP ;old code delete after testing
REC2 S:$D(XDRIOP) IOP="XDRBROWSER1" S:'$D(XDRIOP) %ZIS="QM"
S %ZIS("A")="DEVICE FOR SECOND RECORD: "
W ! D ^%ZIS Q:POP
I $D(IO("Q")) D G PRINTX ;Will queue to TaskMan
. S ZTRTN="QUEUE^XDRRMRG2",ZTIO=ION,ZTDESC="XDR Health Summary for second patient."
. S DFN=DFNTOX,TYPE=QLIST("TYPE"),ZTSAVE("DFN")="",ZTSAVE("TYPE")=""
. D ^%ZTLOAD W:$D(ZTSK) !!,"Queued as task "_ZTSK,!
. Q
U IO(0) W:$D(XDRIOP) " Getting second entry ",!
D ENX^GMTSDVR(DFNTOX,QLIST("TYPE"))
D ^%ZISC U IO(0)
S ^TMP("XDRRMRG",$J,"ENTER <PF1>S TO VIEW OTHER- "_$E($G(DFNTO(1)),1,30)_" "_$G(DFNTO(2))_" ("_DFNTOX_")")="^TMP(""XDRRMRG1"",$J,2)"
M ^TMP("XDRRMRG1",$J,2)=^TMP("DDB",$J)
D DOCLIST^DDBR($NA(^TMP("XDRRMRG",$J)),"R")
K ^TMP("XDRRMRG1",$J),^TMP("XDRRMRG",$J)
PRINT2X Q
;
QUEUE ;Will process the print task for patients' health summaries.
D ENX^GMTSDVR(DFN,TYPE)
QUEUEX Q
;
COUNT(XDRFILE,FROM,TO) ;
N X,I,FIL1,FIL2,NOD,PIECE,X1,X2,N1,N2
S N1=0,N2=0
S FIL2=^DIC(XDRFILE,0,"GL")
S FIL1=FIL2_"FROM)"
S FIL2=FIL2_"TO)"
F I=0:0 S I=$O(^DD(XDRFILE,I)) Q:I'>0 S X=^(I,0) D
. S NOD=$P($P(X,U,4),";")
. S PIECE=$P($P(X,U,4),";",2)
. I PIECE>0 D
. . S X1=$P($G(@FIL1@(NOD)),U,PIECE)
. . S X2=$P($G(@FIL2@(NOD)),U,PIECE)
. . I X1'="",X2="" S N1=N1+1
. . I X2'="",X1="" S N2=N2+1
COUNTX Q $S(N1>N2:2,N2>N1:1,1:0)
;
LABIEN(FILE,REC) ;REM - Resolve LABs DFNFR and DFNTO.
S NAMREC=""
S FILDIC=$G(^DIC(FILE,0,"GL")) Q:FILDIC="" NAMREC
S FILREC=FILDIC_"REC)"
S NAMREC=+$P(@FILREC@(0),U,3)
LABIENX Q NAMREC
XDRRMRG2 ;SF-IRMFO/GB,JLI - GET PATIENT HEALTH SUMMARY ;06/26/98 13:35 [ 04/02/2003 8:47 AM ]
+1 ;;7.3;TOOLKIT;**23,29,1001,1003**;Apr 03, 1995
+2 ;IHS/OIT/LJF 07/27/2006 PATCH 1003 use IHS merge type as default HS
+3 ; PATCH 1003 change default on using browser to NO
+4 ;;
ASK(QLIST,ABORT) ; Report-specific questions
+1 NEW DIC,Y,DTOUT,DUOUT
+2 ; Which patient?
+3 ; S DIC="^SPNL(154,"
+4 ; S DIC("S")="I $P(^(0),U,3)=""A""" ; Select only from active patients
+5 ; S DIC(0)="AEQM"
+6 ; S DIC("A")="Select SCD Patient: "
+7 ; S DIC("?")="Select the patient for whom you want the Health Summary"
+8 ; D ^DIC I $D(DTOUT)!($D(DUOUT))!(Y<0) S ABORT=1 Q
+9 ; S QLIST("DFN")=+Y ; IEN's are DINUM'd to the ^DPT
+10 KILL DIC
+11 ; Which Health Summary Type?
+12 SET DIC="^GMT(142,"
+13 SET DIC(0)="AEQM"
+14 ;
+15 ;IHS/OIT/LJF 07/27/2006 PATCH 1003 added default
IF $$GET^XPAR("PKG","BPM USE IHS LOGIC")
SET DIC("B")="BPM MERGE"
+16 ;
+17 SET DIC("A")="Select Health Summary Type Name: "
+18 ;S DIC("?")="Choose one, if you aren't sure, experiment!"
+19 DO ^DIC
IF $DATA(DTOUT)!($DATA(DUOUT))!(Y<0)
SET ABORT=1
QUIT
+20 SET QLIST("TYPE")=+Y
ASKX QUIT
+1 ;
GATHER(DFN,FDATE,TDATE,HIUSERS,QLIST) ; No need to gather
+1 QUIT
+2 ;
PRINT(QLIST) ;Call to print health summary
+1 DO ENX^GMTSDVR(QLIST("DFN"),QLIST("TYPE"))
PRINTX QUIT
+1 ;
PRINT2 ;Prints the record pair using the Browser of to a device.
+1 NEW XDRIOP
+2 WRITE !
SET DIR(0)="Y"
SET DIR("A",1)="Would you like to use the FM Browser to"
+3 SET DIR("A")="view the record pair"
+4 SET DIR("B")="YES"
SET DIR("?")="You may use FM Browser to view the record pair else you will be prompted to select a device for each record."
+5 ;
+6 ;IHS/OIT/LJF 07/27/2006 PATCH 1003 changed default to NO
+7 IF $$GET^XPAR("PKG","BPM USE IHS LOGIC")
SET DIR("B")="NO"
+8 ;
+9 DO ^DIR
IF Y=1
SET XDRIOP=1
IF $DATA(DIRUT)
QUIT
+10 KILL ^TMP("XDRRMRG1",$JOB),^TMP("XDRRMRG",$JOB)
+11 ;S IOP="XDRBROWSER1" D ^%ZIS Q:POP ;Old code, delete after testing
REC1 IF $DATA(XDRIOP)
SET IOP="XDRBROWSER1"
IF '$DATA(XDRIOP)
SET %ZIS="QM"
+1 SET %ZIS("A")="DEVICE FOR FIRST RECORD: "
+2 WRITE !
DO ^%ZIS
IF POP
QUIT
+3 ;Will queue to TaskMan
IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="QUEUE^XDRRMRG2"
SET ZTIO=ION
SET ZTDESC="XDR Health Summary for first patient."
+5 SET DFN=DFNFRX
SET TYPE=QLIST("TYPE")
SET ZTSAVE("DFN")=""
SET ZTSAVE("TYPE")=""
+6 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !!,"Queued as task "_ZTSK,!
+7 QUIT
End DoDot:1
GOTO REC2
+8 USE IO(0)
IF $DATA(XDRIOP)
WRITE " Getting first entry ",!
+9 DO ENX^GMTSDVR(DFNFRX,QLIST("TYPE"))
+10 USE IO
DO ^%ZISC
+11 SET ^TMP("XDRRMRG",$JOB,"ENTER <PF1>S TO VIEW OTHER- "_$EXTRACT($GET(DFNFR(1)),1,30)_" "_$GET(DFNFR(2))_" ("_DFNFRX_")")="^TMP(""XDRRMRG1"",$J,1)"
+12 MERGE ^TMP("XDRRMRG1",$JOB,1)=^TMP("DDB",$JOB)
+13 ;S IOP="XDRBROWSER1" D ^%ZIS Q:POP ;old code delete after testing
REC2 IF $DATA(XDRIOP)
SET IOP="XDRBROWSER1"
IF '$DATA(XDRIOP)
SET %ZIS="QM"
+1 SET %ZIS("A")="DEVICE FOR SECOND RECORD: "
+2 WRITE !
DO ^%ZIS
IF POP
QUIT
+3 ;Will queue to TaskMan
IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="QUEUE^XDRRMRG2"
SET ZTIO=ION
SET ZTDESC="XDR Health Summary for second patient."
+5 SET DFN=DFNTOX
SET TYPE=QLIST("TYPE")
SET ZTSAVE("DFN")=""
SET ZTSAVE("TYPE")=""
+6 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !!,"Queued as task "_ZTSK,!
+7 QUIT
End DoDot:1
GOTO PRINTX
+8 USE IO(0)
IF $DATA(XDRIOP)
WRITE " Getting second entry ",!
+9 DO ENX^GMTSDVR(DFNTOX,QLIST("TYPE"))
+10 DO ^%ZISC
USE IO(0)
+11 SET ^TMP("XDRRMRG",$JOB,"ENTER <PF1>S TO VIEW OTHER- "_$EXTRACT($GET(DFNTO(1)),1,30)_" "_$GET(DFNTO(2))_" ("_DFNTOX_")")="^TMP(""XDRRMRG1"",$J,2)"
+12 MERGE ^TMP("XDRRMRG1",$JOB,2)=^TMP("DDB",$JOB)
+13 DO DOCLIST^DDBR($NAME(^TMP("XDRRMRG",$JOB)),"R")
+14 KILL ^TMP("XDRRMRG1",$JOB),^TMP("XDRRMRG",$JOB)
PRINT2X QUIT
+1 ;
QUEUE ;Will process the print task for patients' health summaries.
+1 DO ENX^GMTSDVR(DFN,TYPE)
QUEUEX QUIT
+1 ;
COUNT(XDRFILE,FROM,TO) ;
+1 NEW X,I,FIL1,FIL2,NOD,PIECE,X1,X2,N1,N2
+2 SET N1=0
SET N2=0
+3 SET FIL2=^DIC(XDRFILE,0,"GL")
+4 SET FIL1=FIL2_"FROM)"
+5 SET FIL2=FIL2_"TO)"
+6 FOR I=0:0
SET I=$ORDER(^DD(XDRFILE,I))
IF I'>0
QUIT
SET X=^(I,0)
Begin DoDot:1
+7 SET NOD=$PIECE($PIECE(X,U,4),";")
+8 SET PIECE=$PIECE($PIECE(X,U,4),";",2)
+9 IF PIECE>0
Begin DoDot:2
+10 SET X1=$PIECE($GET(@FIL1@(NOD)),U,PIECE)
+11 SET X2=$PIECE($GET(@FIL2@(NOD)),U,PIECE)
+12 IF X1'=""
IF X2=""
SET N1=N1+1
+13 IF X2'=""
IF X1=""
SET N2=N2+1
End DoDot:2
End DoDot:1
COUNTX QUIT $SELECT(N1>N2:2,N2>N1:1,1:0)
+1 ;
LABIEN(FILE,REC) ;REM - Resolve LABs DFNFR and DFNTO.
+1 SET NAMREC=""
+2 SET FILDIC=$GET(^DIC(FILE,0,"GL"))
IF FILDIC=""
QUIT NAMREC
+3 SET FILREC=FILDIC_"REC)"
+4 SET NAMREC=+$PIECE(@FILREC@(0),U,3)
LABIENX QUIT NAMREC
