XDRRMRG2.m

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