AMHLEL ; IHS/CMI/LAB - GETLAYS DAILY ACTIVITY RECORDS ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,5**;JUN 02, 2010;Build 18
;
;CMI/TUCSON/LAB - 10/01/97 - patch 1 - reformatted display to put back in activity time in minutes
;Display all records for the provider, program, on this date.
;
;caller must pass AMHDATE - date of encounter
; AMHDATE - date in fileman format, no time or sec
;passed back to caller: AMHRCNT - number of records found
; ^TMP("AMHVRECS",$J,n,ien)="" n is consecutive
; number
;
Q
EN ;EP
Q:'$G(AMHRS)
D REC
S AMHVREC=AMHX
D EOJ
Q
GATHER ;EP - called from AMHUAR
K AMHQUIT,^TMP("AMHVRECS",$J) S AMHRCNT=0
S AMHSD=$P(AMHDATE,".")-1,(AMHODAT,AMHSD)=AMHSD_".9999",AMHSD=$O(^AMHREC("B",AMHSD))
I $P(AMHSD,".")>AMHDATE!(AMHSD="") S Y=AMHDATE D DD^%DT S ^TMP("AMHVRECS",$J,1,0)="No records currently on file for "_Y S AMHRCNT=1 D EOJ Q
D GETRECS
EOJ K AMHQUIT,AMHPG,AMHREC,AMHV,AMHP,Y,AMHPREC,AMHHRN,X,Y,Z,%,AMHX,AMHSD,AMHODAT,AMHX,I,L,V,AMHRS
Q
GETRECS ;
S (AMHRCNT,AMHV)=0 F S AMHODAT=$O(^AMHREC("B",AMHODAT)) Q:AMHODAT=""!($P(AMHODAT,".")>$P(AMHDATE,"."))!($D(AMHQUIT)) D
.S AMHV=0 F S AMHV=$O(^AMHREC("B",AMHODAT,AMHV)) Q:AMHV'=+AMHV!($D(AMHQUIT)) D
..;I '$$ALLOW(AMHV) Q
..I '$$ALLOWVI^AMHUTIL(DUZ,AMHV) Q ;can't see visits to this location/this user
..S X=$P(^AMHREC(AMHV,0),U,8) I X,'$$ALLOWP^AMHUTIL(DUZ,X) Q ;can't look at data for this patient
..S P=$$PPNAME^AMHUTIL(AMHV),N=$S($P(^AMHREC(AMHV,0),U,8):$P(^DPT($P(^AMHREC(AMHV,0),U,8),0),U),1:"ZZZZZZZ"),AMHHOLD($S(P]"":P,1:"ZZZZ"),N,AMHV)=""
S AMHP1="" F S AMHP1=$O(AMHHOLD(AMHP1)) Q:AMHP1="" S AMHN1="" F S AMHN1=$O(AMHHOLD(AMHP1,AMHN1)) Q:AMHN1="" S AMHV=0 F S AMHV=$O(AMHHOLD(AMHP1,AMHN1,AMHV)) Q:AMHV'=+AMHV D
.S AMHRCNT=AMHRCNT+1,AMHRS=AMHRCNT,^TMP("AMHVRECS",$J,"IDX",AMHRCNT,AMHRCNT)=AMHV,AMHREC=^AMHREC(AMHV,0) D REC S ^TMP("AMHVRECS",$J,AMHRCNT,0)=AMHX
K AMHHOLD,P,N,V,AMHN1,AMHP1
D EOJ
Q
;
REC ;
S AMHX=" " I $$ESIGREQ^AMHESIG(AMHV),$P($G(^AMHREC(AMHV,11)),U,12)="" S AMHX="*"
S AMHX=AMHX_$J(AMHRS,3)_" " S X=$$PPINI^AMHUTIL(AMHV),X=$$LBLK(X,4) S AMHX=AMHX_X_" "_$S($P(AMHREC,U,8):$E($P(^DPT($P(AMHREC,U,8),0),U),1,15),1:" --")
S AMHX=$$RBLK(AMHX,26)
I $P(AMHREC,U,8)]"" D
.I $P(AMHREC,U,4),$D(^AUPNPAT($P(AMHREC,U,8),41,$P(AMHREC,U,4))) S AMHHRN=$P(^AUTTLOC($P(AMHREC,U,4),0),U,7)_$P(^AUPNPAT($P(AMHREC,U,8),41,$P(AMHREC,U,4),0),U,2) Q
.I $D(^AUPNPAT($P(AMHREC,U,8),41,DUZ(2))) S AMHHRN=$P(^AUTTLOC(DUZ(2),0),U,7)_$P(^AUPNPAT($P(AMHREC,U,8),41,DUZ(2),0),U,2) Q
.S AMHHRN="<*****>"
E S AMHHRN="-----"
S AMHHRN=$$RBLK(AMHHRN,10)
S AMHX=AMHX_AMHHRN S AMHX=$$RBLK(AMHX,38)
;S AMHX=AMHX_$S($P(AMHREC,U,4)]"":$E($P(^DIC(4,$P(AMHREC,U,4),0),U),1,6),1:"???") ;CMI/TUCSON/LAB - 10/06/97 - patch 1 reformatted loc
;S AMHX=$$RBLK(AMHX,44) ;CMI/TUCSON/LAB
S AMHX=AMHX_$S($P(AMHREC,U,4):$P(^AUTTLOC($P(AMHREC,U,4),0),U,7),1:"??")
S AMHX=$$RBLK(AMHX,42)
I $P(AMHREC,U,4) S AMHX=AMHX_" "_$$VAL^XBDIQ1(9002011,AMHV,.06)
S AMHX=$$RBLK(AMHX,46)
S AMHP=$O(^AMHRPRO("AD",AMHV,0)) I AMHP="" S X=" <No Problems recorded.>",X=$$RBLK(X,29),AMHX=AMHX_X Q
D GETPROB
Q
GETPROB ;
S AMHP=$O(^AMHRPRO("AD",AMHV,0)),AMHPREC=^AMHRPRO(AMHP,0)
S X=$P(^AMHPROB($P(AMHPREC,U),0),U),X=$$LBLK(X,6)_" "
S X=X_$$GET1^DIQ(9002011.01,AMHP,.04)
S AMHX=AMHX_" "_X
Q
GETHRN ;
S AMHHRN=""
I $P(AMHREC,U,4)]"" D
.I $D(^AUPNPAT($P(AMHREC,U,4),41,$P(AMHREC,U,4))) S AMHHRN=$P(^AUTTLOC($P(AMHREC,U,4),0),U,7)_$P(^AUPNPAT($P(AMHREC,U,4),41,$P(AMHREC,U,4),0),U,2) Q
.I $D(^AUPNPAT($P(AMHREC,U,4),41,DUZ(2))) S AMHHRN=$P(^AUTTLOC(DUZ(2),0),U,7)_$P(^AUPNPAT($P(AMHREC,U,4),41,DUZ(2),0),U,2) Q
.S AMHHRN="<none>"
E S AMHHRN=" -- "
Q
RBLK(V,L) ;left blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=V_" "
Q V
LBLK(V,L) ;left blank fill
NEW %,I
S %=$L(V),Z=L-% F I=1:1:Z S V=" "_V
Q V
ALLOW(R) ;
I $D(^AMHSITE(DUZ(2),16,DUZ)) Q 1 ;allow all with access
NEW X,G S G=0 S X=0 F S X=$O(^AMHRPROV("AD",R,X)) Q:X'=+X I $P(^AMHRPROV(X,0),U)=DUZ S G=1
I G Q 1
I $P(^AMHREC(R,0),U,19)=DUZ Q 1
Q 0
AMHLEL ; IHS/CMI/LAB - GETLAYS DAILY ACTIVITY RECORDS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,5**;JUN 02, 2010;Build 18
+2 ;
+3 ;CMI/TUCSON/LAB - 10/01/97 - patch 1 - reformatted display to put back in activity time in minutes
+4 ;Display all records for the provider, program, on this date.
+5 ;
+6 ;caller must pass AMHDATE - date of encounter
+7 ; AMHDATE - date in fileman format, no time or sec
+8 ;passed back to caller: AMHRCNT - number of records found
+9 ; ^TMP("AMHVRECS",$J,n,ien)="" n is consecutive
+10 ; number
+11 ;
+12 QUIT
EN ;EP
+1 IF '$GET(AMHRS)
QUIT
+2 DO REC
+3 SET AMHVREC=AMHX
+4 DO EOJ
+5 QUIT
GATHER ;EP - called from AMHUAR
+1 KILL AMHQUIT,^TMP("AMHVRECS",$JOB)
SET AMHRCNT=0
+2 SET AMHSD=$PIECE(AMHDATE,".")-1
SET (AMHODAT,AMHSD)=AMHSD_".9999"
SET AMHSD=$ORDER(^AMHREC("B",AMHSD))
+3 IF $PIECE(AMHSD,".")>AMHDATE!(AMHSD="")
SET Y=AMHDATE
DO DD^%DT
SET ^TMP("AMHVRECS",$JOB,1,0)="No records currently on file for "_Y
SET AMHRCNT=1
DO EOJ
QUIT
+4 DO GETRECS
EOJ KILL AMHQUIT,AMHPG,AMHREC,AMHV,AMHP,Y,AMHPREC,AMHHRN,X,Y,Z,%,AMHX,AMHSD,AMHODAT,AMHX,I,L,V,AMHRS
+1 QUIT
GETRECS ;
+1 SET (AMHRCNT,AMHV)=0
FOR
SET AMHODAT=$ORDER(^AMHREC("B",AMHODAT))
IF AMHODAT=""!($PIECE(AMHODAT,".")>$PIECE(AMHDATE,"."))!($DATA(AMHQUIT))
QUIT
Begin DoDot:1
+2 SET AMHV=0
FOR
SET AMHV=$ORDER(^AMHREC("B",AMHODAT,AMHV))
IF AMHV'=+AMHV!($DATA(AMHQUIT))
QUIT
Begin DoDot:2
+3 ;I '$$ALLOW(AMHV) Q
+4 ;can't see visits to this location/this user
IF '$$ALLOWVI^AMHUTIL(DUZ,AMHV)
QUIT
+5 ;can't look at data for this patient
SET X=$PIECE(^AMHREC(AMHV,0),U,8)
IF X
IF '$$ALLOWP^AMHUTIL(DUZ,X)
QUIT
+6 SET P=$$PPNAME^AMHUTIL(AMHV)
SET N=$SELECT($PIECE(^AMHREC(AMHV,0),U,8):$PIECE(^DPT($PIECE(^AMHREC(AMHV,0),U,8),0),U),1:"ZZZZZZZ")
SET AMHHOLD($SELECT(P]"":P,1:"ZZZZ"),N,AMHV)=""
End DoDot:2
End DoDot:1
+7 SET AMHP1=""
FOR
SET AMHP1=$ORDER(AMHHOLD(AMHP1))
IF AMHP1=""
QUIT
SET AMHN1=""
FOR
SET AMHN1=$ORDER(AMHHOLD(AMHP1,AMHN1))
IF AMHN1=""
QUIT
SET AMHV=0
FOR
SET AMHV=$ORDER(AMHHOLD(AMHP1,AMHN1,AMHV))
IF AMHV'=+AMHV
QUIT
Begin DoDot:1
+8 SET AMHRCNT=AMHRCNT+1
SET AMHRS=AMHRCNT
SET ^TMP("AMHVRECS",$JOB,"IDX",AMHRCNT,AMHRCNT)=AMHV
SET AMHREC=^AMHREC(AMHV,0)
DO REC
SET ^TMP("AMHVRECS",$JOB,AMHRCNT,0)=AMHX
End DoDot:1
+9 KILL AMHHOLD,P,N,V,AMHN1,AMHP1
+10 DO EOJ
+11 QUIT
+12 ;
REC ;
+1 SET AMHX=" "
IF $$ESIGREQ^AMHESIG(AMHV)
IF $PIECE($GET(^AMHREC(AMHV,11)),U,12)=""
SET AMHX="*"
+2 SET AMHX=AMHX_$JUSTIFY(AMHRS,3)_" "
SET X=$$PPINI^AMHUTIL(AMHV)
SET X=$$LBLK(X,4)
SET AMHX=AMHX_X_" "_$SELECT($PIECE(AMHREC,U,8):$EXTRACT($PIECE(^DPT($PIECE(AMHREC,U,8),0),U),1,15),1:" --")
+3 SET AMHX=$$RBLK(AMHX,26)
+4 IF $PIECE(AMHREC,U,8)]""
Begin DoDot:1
+5 IF $PIECE(AMHREC,U,4)
IF $DATA(^AUPNPAT($PIECE(AMHREC,U,8),41,$PIECE(AMHREC,U,4)))
SET AMHHRN=$PIECE(^AUTTLOC($PIECE(AMHREC,U,4),0),U,7)_$PIECE(^AUPNPAT($PIECE(AMHREC,U,8),41,$PIECE(AMHREC,U,4),0),U,2)
QUIT
+6 IF $DATA(^AUPNPAT($PIECE(AMHREC,U,8),41,DUZ(2)))
SET AMHHRN=$PIECE(^AUTTLOC(DUZ(2),0),U,7)_$PIECE(^AUPNPAT($PIECE(AMHREC,U,8),41,DUZ(2),0),U,2)
QUIT
+7 SET AMHHRN="<*****>"
End DoDot:1
+8 IF '$TEST
SET AMHHRN="-----"
+9 SET AMHHRN=$$RBLK(AMHHRN,10)
+10 SET AMHX=AMHX_AMHHRN
SET AMHX=$$RBLK(AMHX,38)
+11 ;S AMHX=AMHX_$S($P(AMHREC,U,4)]"":$E($P(^DIC(4,$P(AMHREC,U,4),0),U),1,6),1:"???") ;CMI/TUCSON/LAB - 10/06/97 - patch 1 reformatted loc
+12 ;S AMHX=$$RBLK(AMHX,44) ;CMI/TUCSON/LAB
+13 SET AMHX=AMHX_$SELECT($PIECE(AMHREC,U,4):$PIECE(^AUTTLOC($PIECE(AMHREC,U,4),0),U,7),1:"??")
+14 SET AMHX=$$RBLK(AMHX,42)
+15 IF $PIECE(AMHREC,U,4)
SET AMHX=AMHX_" "_$$VAL^XBDIQ1(9002011,AMHV,.06)
+16 SET AMHX=$$RBLK(AMHX,46)
+17 SET AMHP=$ORDER(^AMHRPRO("AD",AMHV,0))
IF AMHP=""
SET X=" <No Problems recorded.>"
SET X=$$RBLK(X,29)
SET AMHX=AMHX_X
QUIT
+18 DO GETPROB
+19 QUIT
GETPROB ;
+1 SET AMHP=$ORDER(^AMHRPRO("AD",AMHV,0))
SET AMHPREC=^AMHRPRO(AMHP,0)
+2 SET X=$PIECE(^AMHPROB($PIECE(AMHPREC,U),0),U)
SET X=$$LBLK(X,6)_" "
+3 SET X=X_$$GET1^DIQ(9002011.01,AMHP,.04)
+4 SET AMHX=AMHX_" "_X
+5 QUIT
GETHRN ;
+1 SET AMHHRN=""
+2 IF $PIECE(AMHREC,U,4)]""
Begin DoDot:1
+3 IF $DATA(^AUPNPAT($PIECE(AMHREC,U,4),41,$PIECE(AMHREC,U,4)))
SET AMHHRN=$PIECE(^AUTTLOC($PIECE(AMHREC,U,4),0),U,7)_$PIECE(^AUPNPAT($PIECE(AMHREC,U,4),41,$PIECE(AMHREC,U,4),0),U,2)
QUIT
+4 IF $DATA(^AUPNPAT($PIECE(AMHREC,U,4),41,DUZ(2)))
SET AMHHRN=$PIECE(^AUTTLOC(DUZ(2),0),U,7)_$PIECE(^AUPNPAT($PIECE(AMHREC,U,4),41,DUZ(2),0),U,2)
QUIT
+5 SET AMHHRN="<none>"
End DoDot:1
+6 IF '$TEST
SET AMHHRN=" -- "
+7 QUIT
RBLK(V,L) ;left blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=V_" "
+3 QUIT V
LBLK(V,L) ;left blank fill
+1 NEW %,I
+2 SET %=$LENGTH(V)
SET Z=L-%
FOR I=1:1:Z
SET V=" "_V
+3 QUIT V
ALLOW(R) ;
+1 ;allow all with access
IF $DATA(^AMHSITE(DUZ(2),16,DUZ))
QUIT 1
+2 NEW X,G
SET G=0
SET X=0
FOR
SET X=$ORDER(^AMHRPROV("AD",R,X))
IF X'=+X
QUIT
IF $PIECE(^AMHRPROV(X,0),U)=DUZ
SET G=1
+3 IF G
QUIT 1
+4 IF $PIECE(^AMHREC(R,0),U,19)=DUZ
QUIT 1
+5 QUIT 0
