- 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
