AMHLEFP.m

AMHLEFP ; IHS/CMI/LAB - PRINT ENCOUNTER RECORD ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 ;print individual forms for each member of group

START ;

 I '$D(IOF) D HOME^%ZIS

 W @(IOF),!!

 W "**********  ENCOUNTER FORM PRINT  **********",!!

 W "This report will produce hard copy computer generated encounter forms.",!

GETDATES ;

BD ;get beginning date

 W !,"Please enter the date range for which forms should be printed.",!

 W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S AMHBD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_AMHBD_":DT:EP",DIR("A")="Enter ending Date" S Y=AMHBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S AMHED=Y

 S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y

 ;

PAT ;one or all patients

 S AMHPAT=""

 S DIR(0)="Y",DIR("A")="Do you wish to print forms for one particular PATIENT",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) GETDATES

 G:'Y PROV

 I Y=1 S DIC("A")="Enter PATIENT Name: ",DIC=9000001,DIC(0)="AEQMZ" D ^DIC G PAT:Y<0 S AMHPAT=+Y I '$$ALLOWP^AMHUTIL(DUZ,AMHPAT) D NALLOWP^AMHUTIL S AMHPAT="" G PAT

PROV ;limit by provider

 K DIC

 S AMHPROV=""

 S DIR(0)="Y",DIR("A")="Do you wish to print forms for one particular PROVIDER",DIR("B")="Y" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 G:$D(DIRUT) GETDATES

 G:'Y FORMAT

 I Y=1 S DIC("A")="Enter PROVIDER Name: ",DIC=200,DIC(0)="AEQMZ" D ^DIC G PROV:Y<0 S AMHPROV=+Y

FORMAT ;

 K AMHEFT,AMHEFTH

 D FORMDIR()

 I $D(DIRUT) G PROV

 S (AMHEFT,AMHEFTH)=Y

 I 'AMHPAT S AMHDOLOG=1

ZIS ;EP

 S XBRC="COMP^AMHLEFP",XBRP="PRINT^AMHLEFP",XBNS="AMH",XBRX="XIT^AMHLEFP"

 D ^XBDBQUE

 ;

XIT ;

 K ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHPROV,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D,AMHC,AMHEFT,AMHEFTH,AMHPAT

 K AMHPRNM,AMHPRNT,AMHNOLOG,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP,AMHHRN,AMHODAT,AMHQUIT,AMHR0,AMHTICL,AMHTNRQ,AMHTQ,AMHTTXT

 K AMHDOLOG

 Q

COMP ;EP - do nothing

 Q

PRINT ; EP - print individual forms

 S AMHQUIT=0

D ; Run by visit date

 S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X

 S AMHODAT=AMHSD_".9999" F  S AMHODAT=$O(^AMHREC("B",AMHODAT)) Q:AMHODAT=""!((AMHODAT\1)>AMHED)!(AMHQUIT)  D V1

 Q

V1 ;

 S (AMHR,AMHRCNT)=0 F  S AMHR=$O(^AMHREC("B",AMHODAT,AMHR)) Q:AMHR'=+AMHR!(AMHQUIT)  I $D(^AMHREC(AMHR,0)),$P(^(0),U,2)]"",$P(^(0),U,3)]"" D  I F D PRINT1

 .;CHECK PATIENT

 .S F=0

 .I '$$ALLOWVI^AMHUTIL(DUZ,AMHR) Q  ;not allowed to see visits to this location

 .I AMHPAT,$P(^AMHREC(AMHR,0),U,8)'=AMHPAT Q

 .I '$$ALLOWP^AMHUTIL(DUZ,$P(^AMHREC(AMHR,0),U,8))

 .S F=1

 .;CHECK PROVIDER

 .S F=0

 .I 'AMHPROV S F=1 Q

 .S X=0,F=0 F  S X=$O(^AMHRPROV("AD",AMHR,X)) Q:X'=+X  I AMHPROV=$P(^AMHRPROV(X,0),U) S F=1

 Q

PRINT1 ;

 W:$D(IOF) @IOF

 ;I AMHEFTH="B" S AMHEFT="S" D PRINT1^AMHLEFP2(AMHR) Q:AMHQUIT  S AMHEFT="F" W:$D(IOF) @IOF D PRINT1^AMHLEFP2(AMHR) Q

 ;D PRINT1^AMHLEFP2(AMHR)

 S AMHEFT=AMHEFTH

 D ^AMHLEFP2

 Q

 ;

FORMDIR(R) ;EP

 ;

 S R=$G(R)

 K DIR

 W !! S DIR(0)="S^F:Full Encounter Form;S:Suppressed Encounter Form;B:Both a Suppressed & Full;T:2 copies of the Suppressed;E:2 copies of the Full"

 ;S DIR(0)=DIR(0)_$S('$G(R):";W:Print a Copy of the Full Encounter Form without the Intake",$P($G(^AMHREC(R,0)),U,33)="I":";W:Print a Copy of the Full Encounter Form without the Intake",1:"")

 S DIR("B")=$S($P(^AMHSITE(DUZ(2),0),U,23)]"":$P(^AMHSITE(DUZ(2),0),U,23),1:"B")

 S DIR("A")="What type of form do you want to print" K DA D ^DIR K DIR

 Q

AMHLEFP   ; IHS/CMI/LAB - PRINT ENCOUNTER RECORD ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ;print individual forms for each member of group

START     ;

 +1        IF '$DATA(IOF)

               DO HOME^%ZIS

 +2        WRITE @(IOF),!!

 +3        WRITE "**********  ENCOUNTER FORM PRINT  **********",!!

 +4        WRITE "This report will produce hard copy computer generated encounter forms.",!

GETDATES  ;

BD        ;get beginning date

 +1        WRITE !,"Please enter the date range for which forms should be printed.",!

 +2        WRITE !

           SET DIR(0)="D^:DT:EP"

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

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO XIT

 +4        SET AMHBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_AMHBD_":DT:EP"

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

           SET Y=AMHBD

           DO DD^%DT

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET AMHED=Y

 +4        SET X1=AMHBD

           SET X2=-1

           DO C^%DTC

           SET AMHSD=X

           SET Y=AMHBD

           DO DD^%DT

           SET AMHBDD=Y

           SET Y=AMHED

           DO DD^%DT

           SET AMHEDD=Y

 +5       ;

PAT       ;one or all patients

 +1        SET AMHPAT=""

 +2        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to print forms for one particular PATIENT"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO GETDATES

 +4        IF 'Y

               GOTO PROV

 +5        IF Y=1

               SET DIC("A")="Enter PATIENT Name: "

               SET DIC=9000001

               SET DIC(0)="AEQMZ"

               DO ^DIC

               IF Y<0

                   GOTO PAT

               SET AMHPAT=+Y

               IF '$$ALLOWP^AMHUTIL(DUZ,AMHPAT)

                   DO NALLOWP^AMHUTIL

                   SET AMHPAT=""

                   GOTO PAT

PROV      ;limit by provider

 +1        KILL DIC

 +2        SET AMHPROV=""

 +3        SET DIR(0)="Y"

           SET DIR("A")="Do you wish to print forms for one particular PROVIDER"

           SET DIR("B")="Y"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               GOTO GETDATES

 +5        IF 'Y

               GOTO FORMAT

 +6        IF Y=1

               SET DIC("A")="Enter PROVIDER Name: "

               SET DIC=200

               SET DIC(0)="AEQMZ"

               DO ^DIC

               IF Y<0

                   GOTO PROV

               SET AMHPROV=+Y

FORMAT    ;

 +1        KILL AMHEFT,AMHEFTH

 +2        DO FORMDIR()

 +3        IF $DATA(DIRUT)

               GOTO PROV

 +4        SET (AMHEFT,AMHEFTH)=Y

 +5        IF 'AMHPAT

               SET AMHDOLOG=1

ZIS       ;EP

 +1        SET XBRC="COMP^AMHLEFP"

           SET XBRP="PRINT^AMHLEFP"

           SET XBNS="AMH"

           SET XBRX="XIT^AMHLEFP"

 +2        DO ^XBDBQUE

 +3       ;

XIT       ;

 +1        KILL ZTSK,Y,AMHBD,AMHED,IO("Q"),AMH80D,AMHBTH,AMHHRCN,AMHJOB,AMHLENG,AMHPCNT,AMHPG,AMHPROV,AMHX,DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,XBNS,XBRC,XBRP,XBTX,D,AMHC,AMHEFT,AMHEFTH,AMHPAT

 +2        KILL AMHPRNM,AMHPRNT,AMHNOLOG,AMHPROB,AMHPRV,AMHR,AMHRCNT,AMHRLOC,AMHSD,AMHTOT,AMHBDD,AMHBT,AMHEDD,AMHEDO,AMHBDO,AMHBT,AMHFOUND,AMHHIT,AMHID,AMHLINE,AMHP,AMHHRN,AMHODAT,AMHQUIT,AMHR0,AMHTICL,AMHTNRQ,AMHTQ,AMHTTXT

 +3        KILL AMHDOLOG

 +4        QUIT 

COMP      ;EP - do nothing

 +1        QUIT 

PRINT     ; EP - print individual forms

 +1        SET AMHQUIT=0

D         ; Run by visit date

 +1        SET X1=AMHBD

           SET X2=-1

           DO C^%DTC

           SET AMHSD=X

 +2        SET AMHODAT=AMHSD_".9999"

           FOR 

               SET AMHODAT=$ORDER(^AMHREC("B",AMHODAT))

               IF AMHODAT=""!((AMHODAT\1)>AMHED)!(AMHQUIT)

                   QUIT 

               DO V1

 +3        QUIT 

V1        ;

 +1        SET (AMHR,AMHRCNT)=0

           FOR 

               SET AMHR=$ORDER(^AMHREC("B",AMHODAT,AMHR))

               IF AMHR'=+AMHR!(AMHQUIT)

                   QUIT 

               IF $DATA(^AMHREC(AMHR,0))

                   IF $PIECE(^(0),U,2)]""

                       IF $PIECE(^(0),U,3)]""

                           Begin DoDot:1

 +2       ;CHECK PATIENT

 +3                            SET F=0

 +4       ;not allowed to see visits to this location

                               IF '$$ALLOWVI^AMHUTIL(DUZ,AMHR)

                                   QUIT 

 +5                            IF AMHPAT

                                   IF $PIECE(^AMHREC(AMHR,0),U,8)'=AMHPAT

                                       QUIT 

 +6                            IF '$$ALLOWP^AMHUTIL(DUZ,$PIECE(^AMHREC(AMHR,0),U,8))

 +7                            SET F=1

 +8       ;CHECK PROVIDER

 +9                            SET F=0

 +10                           IF 'AMHPROV

                                   SET F=1

                                   QUIT 

 +11                           SET X=0

                               SET F=0

                               FOR 

                                   SET X=$ORDER(^AMHRPROV("AD",AMHR,X))

                                   IF X'=+X

                                       QUIT 

                                   IF AMHPROV=$PIECE(^AMHRPROV(X,0),U)

                                       SET F=1

                           End DoDot:1

                           IF F

                               DO PRINT1

 +12       QUIT 

PRINT1    ;

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2       ;I AMHEFTH="B" S AMHEFT="S" D PRINT1^AMHLEFP2(AMHR) Q:AMHQUIT  S AMHEFT="F" W:$D(IOF) @IOF D PRINT1^AMHLEFP2(AMHR) Q

 +3       ;D PRINT1^AMHLEFP2(AMHR)

 +4        SET AMHEFT=AMHEFTH

 +5        DO ^AMHLEFP2

 +6        QUIT 

 +7       ;

FORMDIR(R) ;EP

 +1       ;

 +2        SET R=$GET(R)

 +3        KILL DIR

 +4        WRITE !!

           SET DIR(0)="S^F:Full Encounter Form;S:Suppressed Encounter Form;B:Both a Suppressed & Full;T:2 copies of the Suppressed;E:2 copies of the Full"

 +5       ;S DIR(0)=DIR(0)_$S('$G(R):";W:Print a Copy of the Full Encounter Form without the Intake",$P($G(^AMHREC(R,0)),U,33)="I":";W:Print a Copy of the Full Encounter Form without the Intake",1:"")

 +6        SET DIR("B")=$SELECT($PIECE(^AMHSITE(DUZ(2),0),U,23)]"":$PIECE(^AMHSITE(DUZ(2),0),U,23),1:"B")

 +7        SET DIR("A")="What type of form do you want to print"

           KILL DA

           DO ^DIR

           KILL DIR

 +8        QUIT