ACDPVDSP.m

ACDPVDSP ;IHS/ADC/EDE/KML - DISPLAY PATIENT VISIT; 

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;

 ; This routine displays a patient's CDMIS visit with subordinate

 ; file entries.

 ;

START ;

 W !

 F  D PATLOOP Q:ACDQ

 D EOJ

 Q

 ;

PATLOOP ; DISPLAY PATIENTS UNTIL DONE

 D GETPAT

 Q:ACDQ

 D GETVSITS^ACDDEU ;       gather all visits for patient

 Q:ACDQ

 D SELECT ;                select visit to display

 Q:ACDQ

 D DISPLAY

 D DEV^ACDDEU Q:ACDQ

 I $D(ACDSLAVE)!(IO'=IO(0)) D DISPTAG

 K ACDSLAVE S IO=IO(0)

 U 0

 Q

 ;

GETPAT ; GET PATIENT

 S ACDQ=1

 S AUPNLK("ALL")=1

 S DIC="^AUPNPAT(",DIC(0)="AEMQ",DIC("S")="I $D(^ACDVIS(""D"",+Y))" D DIC^ACDFMC

 K AUPNLK("ALL")

 Q:Y<0

 S ACDDFNP=+Y,ACDDFN=$P(^DPT(ACDDFNP,0),U)

 S ACDQ=0

 Q

 ;

SELECT ; SELECT A CDMIS VISIT

 S ACDQ=1

 W !

 S ACDVIEN=0

 K ACDVLST

 I $O(^TMP("ACD",$J,"VISITS",0))="" W !,"----------",!,"No CDMIS visits!",!,"----------",! Q

 S ACDDTLOW=0,ACDDTHI=9999999

 I ACDVCNT>20 D GETDTRNG Q:ACDQ  W !

 S ACDQ=1

 W !

 S ACDLC=0

 S ACDX=ACDDTLOW S:ACDX>0 ACDX=ACDX-1

 F  S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:ACDX=""  I ACDX'<ACDDTLOW,ACDX'>ACDDTHI S ACDY=0 F  S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY  D  Q:ACDQ

 . S ACDQ=0

 . S ACDLC=ACDLC+1

 . S ACDVLST(ACDLC)=ACDY

 . S DIC="9002172.1",DA=ACDY,DR=".01;1;3;5",DIQ="ACDPDD("

 . D DIQ1^ACDFMC

 . W ACDLC,?5,ACDPDD(9002172.1,ACDY,.01),?18," - ",ACDPDD(9002172.1,ACDY,1),"/",ACDPDD(9002172.1,ACDY,5)," ",ACDPDD(9002172.1,ACDY,3),!

 . K ACDPDD

 . I '(ACDLC#20) D PAUSE^ACDDEU S:$D(DIRUT) ACDQ=1

 . Q

 S ACDQ=1

 I 'ACDLC W !,"No visits in date range",! Q

 S DIR(0)="NO^1:"_ACDLC,DIR("A")="Select one of the listed visits" K DA D ^DIR K DIR

 S:Y ACDVIEN=ACDVLST(Y)

 K ACDLC,ACDVLST

 Q:'ACDVIEN

 S ACDQ=0

 Q

 ;

GETDTRNG ; GET DATE RANGE FOR VISIT

 S ACDQ=1

 S ACDDTLOW=$O(^TMP("ACD",$J,"VISITS",0)),ACDDTHI=$O(^TMP("ACD",$J,"VISITS","Z"),-1)

 W !,"Patient has ",ACDVCNT," visits between ",$$FMTE^XLFDT(ACDDTLOW,"1")," and ",$$FMTE^XLFDT(ACDDTHI,"1"),".",!,"Enter date range of desired visit.",!

 S DIR(0)="DO^::E",DIR("A")="Enter beginning date" K DA D ^DIR K DIR

 Q:'Y

 S ACDDTLOW=Y

 S DIR(0)="D^"_Y_"::E",DIR("A")="Enter ending date",DIR("B")=X K DA D ^DIR K DIR

 Q:$D(DIRUT)

 S ACDDTHI=Y

 S ACDQ=0

 Q

 ;

DISPLAY ; EP - DISPLAY VISIT AND SUBORDINATE FILE ENTRIES

 I $O(^ACDVIS(ACDVIEN,21,0)) D

 . W !!,"This CDMIS visit has linked PCC visits."

 . S DIR(0)="Y",DIR("A")="Do you want to display the PCC visits also",DIR("B")="N" K DA D ^DIR K DIR

 . S:Y ACDPCCL=1

 . Q

DISPTAG I $D(IO("Q")) D  Q

 . S ZTRTN="DISPLAYQ^ACDPVDSP",ZTDESC="CDMIS VISIT DISPLAY",ZTDTH=$H,ZTSAVE("ACD*")=""

 . D ^%ZTLOAD

 . Q

 D DISPLAYQ S ACDQ=0

 Q

 ;

DISPLAYQ ; EP - FOR TASKMAN

 I $D(ACDSLAVE) S IOP=ACDSLAVE D ^%ZIS

 U IO

 W:IO'=IO(0) @IOF

 D:$E(IOST,1,2)="P-" CONF^ACDDEU

 W !

 D DSPVSIT^ACDDEU(ACDVIEN)

 D:$E(IOST,1,2)'="P-" PAUSE^ACDDEU

 Q:$D(DIRUT)

 S X=$P(^ACDVIS(ACDVIEN,0),U,4)

 I X'="IN",X'="RE",X'="FU",X'="IR",X'="OT",X'="TD",X'="CS" W !,"INVALID TYPE CONTACT",!

 E  S ACDCONT=X D @("DSP"_ACDCONT)

 I $G(ACDPCCL) NEW ACDPCCV S ACDPCCL=0 F  S ACDPCCL=$O(^ACDVIS(ACDVIEN,21,ACDPCCL)) Q:'ACDPCCL  S ACDPCCV=$P(^(ACDPCCL,0),U,2)  I ACDPCCV S APCDVDSP=ACDPCCV D ^APCDVDSP Q:$D(DIRUT)

 I $D(ACDSLAVE) W @IOF D ^%ZISC

 I $D(ZTQUEUED) D EOJ S ZTREQ="@"

 Q

 ;

DSPIN ; DISPLAY INITIAL

 D DSPIIF

 Q

 ;

DSPRE ; DISPLAY REOPEN

 D DSPIIF

 Q

 ;

DSPFU ; DISPLAY FOLLOWUP

 D DSPIIF

 Q

 ;

DSPIR ; DISPLAY INFO/REFERRAL

 D DSPIIF

 Q

 ;

DSPOT ; DISPLAY CRISIS BRIEF

 D DSPIIF

 Q

 ;

DSPIIF ; DISPLAY IIF ENTRY

 S DIC="^ACDIIF(",DA=$O(^ACDIIF("C",ACDVIEN,0))

 I 'DA W !,"NO IIF ENTRY TO DISPLAY",!

 E  D DIQ^ACDFMC

 D:$E(IOST,1,2)'="P-" PAUSE^ACDDEU

 Q

 ;

DSPTD ; DISPLAY TDC ENTRY

 S DIC="^ACDTDC(",DA=$O(^ACDTDC("C",ACDVIEN,0))

 I 'DA W !,"NO TDC ENTRY TO DISPLAY",!

 E  D DIQ^ACDFMC

 D:$E(IOST,1,2)'="P-" PAUSE^ACDDEU

 Q

 ;

DSPCS ; DISPLAY CLIENT SERVICES

 S ACDY=0

 S ACDQ=0

 F  S ACDY=$O(^ACDCS("C",ACDVIEN,ACDY)) Q:'ACDY  D  Q:$D(DIRUT)

 . S DIC="^ACDCS(",DA=ACDY

 . D DIQ^ACDFMC

 . I $E(IOST,1,2)'="P-" D PAUSE^ACDDEU

 . Q

 S ACDQ=0

 Q

 ;

EOJ ;

 D ^%ZISC

 D ^ACDKILL

 Q

ACDPVDSP  ;IHS/ADC/EDE/KML - DISPLAY PATIENT VISIT; 

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

 +3       ; This routine displays a patient's CDMIS visit with subordinate

 +4       ; file entries.

 +5       ;

START     ;

 +1        WRITE !

 +2        FOR 

               DO PATLOOP

               IF ACDQ

                   QUIT 

 +3        DO EOJ

 +4        QUIT 

 +5       ;

PATLOOP   ; DISPLAY PATIENTS UNTIL DONE

 +1        DO GETPAT

 +2        IF ACDQ

               QUIT 

 +3       ;       gather all visits for patient

           DO GETVSITS^ACDDEU

 +4        IF ACDQ

               QUIT 

 +5       ;                select visit to display

           DO SELECT

 +6        IF ACDQ

               QUIT 

 +7        DO DISPLAY

 +8        DO DEV^ACDDEU

           IF ACDQ

               QUIT 

 +9        IF $DATA(ACDSLAVE)!(IO'=IO(0))

               DO DISPTAG

 +10       KILL ACDSLAVE

           SET IO=IO(0)

 +11       USE 0

 +12       QUIT 

 +13      ;

GETPAT    ; GET PATIENT

 +1        SET ACDQ=1

 +2        SET AUPNLK("ALL")=1

 +3        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQ"

           SET DIC("S")="I $D(^ACDVIS(""D"",+Y))"

           DO DIC^ACDFMC

 +4        KILL AUPNLK("ALL")

 +5        IF Y<0

               QUIT 

 +6        SET ACDDFNP=+Y

           SET ACDDFN=$PIECE(^DPT(ACDDFNP,0),U)

 +7        SET ACDQ=0

 +8        QUIT 

 +9       ;

SELECT    ; SELECT A CDMIS VISIT

 +1        SET ACDQ=1

 +2        WRITE !

 +3        SET ACDVIEN=0

 +4        KILL ACDVLST

 +5        IF $ORDER(^TMP("ACD",$JOB,"VISITS",0))=""

               WRITE !,"----------",!,"No CDMIS visits!",!,"----------",!

               QUIT 

 +6        SET ACDDTLOW=0

           SET ACDDTHI=9999999

 +7        IF ACDVCNT>20

               DO GETDTRNG

               IF ACDQ

                   QUIT 

               WRITE !

 +8        SET ACDQ=1

 +9        WRITE !

 +10       SET ACDLC=0

 +11       SET ACDX=ACDDTLOW

           IF ACDX>0

               SET ACDX=ACDX-1

 +12       FOR 

               SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX))

               IF ACDX=""

                   QUIT 

               IF ACDX'<ACDDTLOW

                   IF ACDX'>ACDDTHI

                       SET ACDY=0

                       FOR 

                           SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY))

                           IF 'ACDY

                               QUIT 

                           Begin DoDot:1

 +13                           SET ACDQ=0

 +14                           SET ACDLC=ACDLC+1

 +15                           SET ACDVLST(ACDLC)=ACDY

 +16                           SET DIC="9002172.1"

                               SET DA=ACDY

                               SET DR=".01;1;3;5"

                               SET DIQ="ACDPDD("

 +17                           DO DIQ1^ACDFMC

 +18                           WRITE ACDLC,?5,ACDPDD(9002172.1,ACDY,.01),?18," - ",ACDPDD(9002172.1,ACDY,1),"/",ACDPDD(9002172.1,ACDY,5)," ",ACDPDD(9002172.1,ACDY,3),!

 +19                           KILL ACDPDD

 +20                           IF '(ACDLC#20)

                                   DO PAUSE^ACDDEU

                                   IF $DATA(DIRUT)

                                       SET ACDQ=1

 +21                           QUIT 

                           End DoDot:1

                           IF ACDQ

                               QUIT 

 +22       SET ACDQ=1

 +23       IF 'ACDLC

               WRITE !,"No visits in date range",!

               QUIT 

 +24       SET DIR(0)="NO^1:"_ACDLC

           SET DIR("A")="Select one of the listed visits"

           KILL DA

           DO ^DIR

           KILL DIR

 +25       IF Y

               SET ACDVIEN=ACDVLST(Y)

 +26       KILL ACDLC,ACDVLST

 +27       IF 'ACDVIEN

               QUIT 

 +28       SET ACDQ=0

 +29       QUIT 

 +30      ;

GETDTRNG  ; GET DATE RANGE FOR VISIT

 +1        SET ACDQ=1

 +2        SET ACDDTLOW=$ORDER(^TMP("ACD",$JOB,"VISITS",0))

           SET ACDDTHI=$ORDER(^TMP("ACD",$JOB,"VISITS","Z"),-1)

 +3        WRITE !,"Patient has ",ACDVCNT," visits between ",$$FMTE^XLFDT(ACDDTLOW,"1")," and ",$$FMTE^XLFDT(ACDDTHI,"1"),".",!,"Enter date range of desired visit.",!

 +4        SET DIR(0)="DO^::E"

           SET DIR("A")="Enter beginning date"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        IF 'Y

               QUIT 

 +6        SET ACDDTLOW=Y

 +7        SET DIR(0)="D^"_Y_"::E"

           SET DIR("A")="Enter ending date"

           SET DIR("B")=X

           KILL DA

           DO ^DIR

           KILL DIR

 +8        IF $DATA(DIRUT)

               QUIT 

 +9        SET ACDDTHI=Y

 +10       SET ACDQ=0

 +11       QUIT 

 +12      ;

DISPLAY   ; EP - DISPLAY VISIT AND SUBORDINATE FILE ENTRIES

 +1        IF $ORDER(^ACDVIS(ACDVIEN,21,0))

               Begin DoDot:1

 +2                WRITE !!,"This CDMIS visit has linked PCC visits."

 +3                SET DIR(0)="Y"

                   SET DIR("A")="Do you want to display the PCC visits also"

                   SET DIR("B")="N"

                   KILL DA

                   DO ^DIR

                   KILL DIR

 +4                IF Y

                       SET ACDPCCL=1

 +5                QUIT 

               End DoDot:1

DISPTAG    IF $DATA(IO("Q"))

               Begin DoDot:1

 +1                SET ZTRTN="DISPLAYQ^ACDPVDSP"

                   SET ZTDESC="CDMIS VISIT DISPLAY"

                   SET ZTDTH=$HOROLOG

                   SET ZTSAVE("ACD*")=""

 +2                DO ^%ZTLOAD

 +3                QUIT 

               End DoDot:1

               QUIT 

 +4        DO DISPLAYQ

           SET ACDQ=0

 +5        QUIT 

 +6       ;

DISPLAYQ  ; EP - FOR TASKMAN

 +1        IF $DATA(ACDSLAVE)

               SET IOP=ACDSLAVE

               DO ^%ZIS

 +2        USE IO

 +3        IF IO'=IO(0)

               WRITE @IOF

 +4        IF $EXTRACT(IOST,1,2)="P-"

               DO CONF^ACDDEU

 +5        WRITE !

 +6        DO DSPVSIT^ACDDEU(ACDVIEN)

 +7        IF $EXTRACT(IOST,1,2)'="P-"

               DO PAUSE^ACDDEU

 +8        IF $DATA(DIRUT)

               QUIT 

 +9        SET X=$PIECE(^ACDVIS(ACDVIEN,0),U,4)

 +10       IF X'="IN"

               IF X'="RE"

                   IF X'="FU"

                       IF X'="IR"

                           IF X'="OT"

                               IF X'="TD"

                                   IF X'="CS"

                                       WRITE !,"INVALID TYPE CONTACT",!

 +11      IF '$TEST

               SET ACDCONT=X

               DO @("DSP"_ACDCONT)

 +12       IF $GET(ACDPCCL)

               NEW ACDPCCV

               SET ACDPCCL=0

               FOR 

                   SET ACDPCCL=$ORDER(^ACDVIS(ACDVIEN,21,ACDPCCL))

                   IF 'ACDPCCL

                       QUIT 

                   SET ACDPCCV=$PIECE(^(ACDPCCL,0),U,2)

                   IF ACDPCCV

                       SET APCDVDSP=ACDPCCV

                       DO ^APCDVDSP

                       IF $DATA(DIRUT)

                           QUIT 

 +13       IF $DATA(ACDSLAVE)

               WRITE @IOF

               DO ^%ZISC

 +14       IF $DATA(ZTQUEUED)

               DO EOJ

               SET ZTREQ="@"

 +15       QUIT 

 +16      ;

DSPIN     ; DISPLAY INITIAL

 +1        DO DSPIIF

 +2        QUIT 

 +3       ;

DSPRE     ; DISPLAY REOPEN

 +1        DO DSPIIF

 +2        QUIT 

 +3       ;

DSPFU     ; DISPLAY FOLLOWUP

 +1        DO DSPIIF

 +2        QUIT 

 +3       ;

DSPIR     ; DISPLAY INFO/REFERRAL

 +1        DO DSPIIF

 +2        QUIT 

 +3       ;

DSPOT     ; DISPLAY CRISIS BRIEF

 +1        DO DSPIIF

 +2        QUIT 

 +3       ;

DSPIIF    ; DISPLAY IIF ENTRY

 +1        SET DIC="^ACDIIF("

           SET DA=$ORDER(^ACDIIF("C",ACDVIEN,0))

 +2        IF 'DA

               WRITE !,"NO IIF ENTRY TO DISPLAY",!

 +3       IF '$TEST

               DO DIQ^ACDFMC

 +4        IF $EXTRACT(IOST,1,2)'="P-"

               DO PAUSE^ACDDEU

 +5        QUIT 

 +6       ;

DSPTD     ; DISPLAY TDC ENTRY

 +1        SET DIC="^ACDTDC("

           SET DA=$ORDER(^ACDTDC("C",ACDVIEN,0))

 +2        IF 'DA

               WRITE !,"NO TDC ENTRY TO DISPLAY",!

 +3       IF '$TEST

               DO DIQ^ACDFMC

 +4        IF $EXTRACT(IOST,1,2)'="P-"

               DO PAUSE^ACDDEU

 +5        QUIT 

 +6       ;

DSPCS     ; DISPLAY CLIENT SERVICES

 +1        SET ACDY=0

 +2        SET ACDQ=0

 +3        FOR 

               SET ACDY=$ORDER(^ACDCS("C",ACDVIEN,ACDY))

               IF 'ACDY

                   QUIT 

               Begin DoDot:1

 +4                SET DIC="^ACDCS("

                   SET DA=ACDY

 +5                DO DIQ^ACDFMC

 +6                IF $EXTRACT(IOST,1,2)'="P-"

                       DO PAUSE^ACDDEU

 +7                QUIT 

               End DoDot:1

               IF $DATA(DIRUT)

                   QUIT 

 +8        SET ACDQ=0

 +9        QUIT 

 +10      ;

EOJ       ;

 +1        DO ^%ZISC

 +2        DO ^ACDKILL

 +3        QUIT