AMHRPT4 ; IHS/CMI/LAB - PROCESS VISIT LIST ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
START ;
S (AMHBT,AMHBTH)=$H,AMHJOB=$J
D XTMP^AMHUTIL("AMHRPT","BH REPORT")
I $P(^AMHRCNT(AMHRPTC,0),U,11)]"" S AMHRPREP=$P(^(0),U,11) S AMHRPREP=$TR(AMHRPREP,"~","^") D @AMHRPREP
D D,END
Q
;
S ;run by search template
S AMHR=0 F S AMHR=$O(^DIBT(AMHSEAT,1,AMHR)) Q:AMHR'=+AMHR D PROC,EOJ
Q
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) D V1
Q
;
END ;
I $P(^AMHRCNT(AMHRPTC,0),U,9)]"" S AMHRPOSP=$P(^(0),U,9) S AMHRPOSP=$TR(AMHRPOSP,"~","^") D @AMHRPOSP
S AMHET=$H
D EOJ
Q
EOJ ;
K AMHB,AMHI,AMHR,AMHRCNT
Q
V1 ;
S (AMHR,AMHRCNT)=0 F S AMHR=$O(^AMHREC("B",AMHODAT,AMHR)) Q:AMHR'=+AMHR I $D(^AMHREC(AMHR,0)),$P(^(0),U,2)]"",$P(^(0),U,3)]"" S AMHR0=^(0) D PROC
Q
PROC ;
Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)
I $P(AMHR0,U,8) Q:$$DEMO^AMHUTIL1($P(AMHR0,U,8),$G(AMHDEMO))
I $P(AMHR0,U,8) Q:'$$ALLOWP^AMHUTIL(DUZ,$P(AMHR0,U,8))
Q:$P(AMHR0,U,4)=""
Q:$P(AMHR0,U,5)=""
Q:$P(AMHR0,U,6)=""
Q:$P(AMHR0,U,7)=""
D SCREENS
Q:$D(AMHSKIP)
I $P(^AMHRCNT(AMHRPTC,0),U,8) K AMHSRT,AMHPRNT S AMHCRIT=AMHSORT,AMHX=0 X:$D(^AMHSORT(AMHSORT,5)) ^AMHSORT(AMHSORT,5) S:'$D(AMHPRNT) AMHPRNT="<NONE AVAILABLE>" S AMHSRT=AMHPRNT
I $G(AMHRPTST)]"" D @(AMHRPTST) Q
S ^XTMP("AMHRPT",AMHJOB,AMHBTH,"RECORDS",AMHSRT,AMHR)=""
Q
SCREENS ;
S DFN=$P(AMHR0,U,8)
K AMHSKIP
S AMHI=0 F S AMHI=$O(^AMHTRPT(AMHRPT,11,AMHI)) Q:AMHI'=+AMHI!($D(AMHSKIP)) D
.I '$P(^AMHSORT(AMHI,0),U,8) D SINGLE Q
.D MULT
.Q
Q
SINGLE ;
K AMHSPEC
S X="",AMHX=0
X:$D(^AMHSORT(AMHI,1)) ^(1)
I X="" S AMHSKIP="" Q
I '$D(AMHSPEC),'$D(^AMHTRPT(AMHRPT,11,AMHI,11,"B",X)) S AMHSKIP="" Q
Q
MULT ;
K AMHFOUN,AMHSKIP,X S AMHX=0,X=""
X:$D(^AMHSORT(AMHI,1)) ^(1)
I '$L($O(X)) S AMHSKIP="" Q
S Y="" F S Y=$O(X(Y)) Q:Y="" I $D(^AMHTRPT(AMHRPT,11,AMHI,11,"B",Y)) S AMHFOUN="" Q
S:'$D(AMHFOUN) AMHSKIP=""
Q
AMHRPT4 ; IHS/CMI/LAB - PROCESS VISIT LIST ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
START ;
+1 SET (AMHBT,AMHBTH)=$HOROLOG
SET AMHJOB=$JOB
+2 DO XTMP^AMHUTIL("AMHRPT","BH REPORT")
+3 IF $PIECE(^AMHRCNT(AMHRPTC,0),U,11)]""
SET AMHRPREP=$PIECE(^(0),U,11)
SET AMHRPREP=$TRANSLATE(AMHRPREP,"~","^")
DO @AMHRPREP
+4 DO D
DO END
+5 QUIT
+6 ;
S ;run by search template
+1 SET AMHR=0
FOR
SET AMHR=$ORDER(^DIBT(AMHSEAT,1,AMHR))
IF AMHR'=+AMHR
QUIT
DO PROC
DO EOJ
+2 QUIT
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)
QUIT
DO V1
+3 QUIT
+4 ;
END ;
+1 IF $PIECE(^AMHRCNT(AMHRPTC,0),U,9)]""
SET AMHRPOSP=$PIECE(^(0),U,9)
SET AMHRPOSP=$TRANSLATE(AMHRPOSP,"~","^")
DO @AMHRPOSP
+2 SET AMHET=$HOROLOG
+3 DO EOJ
+4 QUIT
EOJ ;
+1 KILL AMHB,AMHI,AMHR,AMHRCNT
+2 QUIT
V1 ;
+1 SET (AMHR,AMHRCNT)=0
FOR
SET AMHR=$ORDER(^AMHREC("B",AMHODAT,AMHR))
IF AMHR'=+AMHR
QUIT
IF $DATA(^AMHREC(AMHR,0))
IF $PIECE(^(0),U,2)]""
IF $PIECE(^(0),U,3)]""
SET AMHR0=^(0)
DO PROC
+2 QUIT
PROC ;
+1 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHR)
QUIT
+2 IF $PIECE(AMHR0,U,8)
IF $$DEMO^AMHUTIL1($PIECE(AMHR0,U,8),$GET(AMHDEMO))
QUIT
+3 IF $PIECE(AMHR0,U,8)
IF '$$ALLOWP^AMHUTIL(DUZ,$PIECE(AMHR0,U,8))
QUIT
+4 IF $PIECE(AMHR0,U,4)=""
QUIT
+5 IF $PIECE(AMHR0,U,5)=""
QUIT
+6 IF $PIECE(AMHR0,U,6)=""
QUIT
+7 IF $PIECE(AMHR0,U,7)=""
QUIT
+8 DO SCREENS
+9 IF $DATA(AMHSKIP)
QUIT
+10 IF $PIECE(^AMHRCNT(AMHRPTC,0),U,8)
KILL AMHSRT,AMHPRNT
SET AMHCRIT=AMHSORT
SET AMHX=0
IF $DATA(^AMHSORT(AMHSORT,5))
XECUTE ^AMHSORT(AMHSORT,5)
IF '$DATA(AMHPRNT)
SET AMHPRNT="<NONE AVAILABLE>"
SET AMHSRT=AMHPRNT
+11 IF $GET(AMHRPTST)]""
DO @(AMHRPTST)
QUIT
+12 SET ^XTMP("AMHRPT",AMHJOB,AMHBTH,"RECORDS",AMHSRT,AMHR)=""
+13 QUIT
SCREENS ;
+1 SET DFN=$PIECE(AMHR0,U,8)
+2 KILL AMHSKIP
+3 SET AMHI=0
FOR
SET AMHI=$ORDER(^AMHTRPT(AMHRPT,11,AMHI))
IF AMHI'=+AMHI!($DATA(AMHSKIP))
QUIT
Begin DoDot:1
+4 IF '$PIECE(^AMHSORT(AMHI,0),U,8)
DO SINGLE
QUIT
+5 DO MULT
+6 QUIT
End DoDot:1
+7 QUIT
SINGLE ;
+1 KILL AMHSPEC
+2 SET X=""
SET AMHX=0
+3 IF $DATA(^AMHSORT(AMHI,1))
XECUTE ^(1)
+4 IF X=""
SET AMHSKIP=""
QUIT
+5 IF '$DATA(AMHSPEC)
IF '$DATA(^AMHTRPT(AMHRPT,11,AMHI,11,"B",X))
SET AMHSKIP=""
QUIT
+6 QUIT
MULT ;
+1 KILL AMHFOUN,AMHSKIP,X
SET AMHX=0
SET X=""
+2 IF $DATA(^AMHSORT(AMHI,1))
XECUTE ^(1)
+3 IF '$LENGTH($ORDER(X))
SET AMHSKIP=""
QUIT
+4 SET Y=""
FOR
SET Y=$ORDER(X(Y))
IF Y=""
QUIT
IF $DATA(^AMHTRPT(AMHRPT,11,AMHI,11,"B",Y))
SET AMHFOUN=""
QUIT
+5 IF '$DATA(AMHFOUN)
SET AMHSKIP=""
+6 QUIT
