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
