Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHRP8P

AMHRP8P.m

Go to the documentation of this file.
  1. AMHRP8P ; IHS/CMI/LAB - print active client list ;
  1. ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
  1. ;
  1. ;
  1. PRINT ;
  1. START ;
  1. S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
  1. S AMH80D="-------------------------------------------------------------------------------"
  1. S AMHPG=0 D HEAD
  1. I '$D(^XTMP("AMHRP8",AMHJOB,AMHBTH)) W !!,"NO PATIENTS TO REPORT" G DONE
  1. S DFN="" K AMHQ
  1. S AMHNAME="" F S AMHNAME=$O(^XTMP("AMHRP8",AMHJOB,AMHBTH,AMHNAME)) Q:AMHNAME=""!($D(AMHQ)) D
  1. .S DFN=0 F S DFN=$O(^XTMP("AMHRP8",AMHJOB,AMHBTH,AMHNAME,DFN)) Q:DFN'=+DFN!($D(AMHQ)) D DFN
  1. G:$D(AMHQ) DONE
  1. W !!,"Total Number of Patients: ",AMHTOT
  1. DONE D DONE^AMHLEIN,^AMHEKL
  1. K ^XTMP("AMHRP8",AMHJOB,AMHBTH),AMHJOB,AMHBTH
  1. Q
  1. DFN ;
  1. I $Y>(IOSL-4) D HEAD Q:$D(AMHQ)
  1. S AMHHRCN=$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^(0),U,2),1:"<none>")
  1. W !,$E($P(^DPT(DFN,0),U),1,15),?18,AMHHRCN
  1. W ?27,$P(^DPT(DFN,0),U,2) S Y=$P(^DPT(DFN,0),U,3) W ?31,$E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)
  1. VSTS ; process visits
  1. K AMHRLOC,AMHPRV,AMHPROB
  1. S AMHR=0,AMHBDO=9999999-AMHBD,AMHEDO=9999999-AMHED,AMHSD=AMHED-1,AMHSD=AMHSD_".9999",AMHRCNT=0
  1. F S AMHSD=$O(^AMHREC("AE",DFN,AMHSD)) Q:$P(AMHSD,".")>AMHBDO!(AMHSD="") D
  1. .S AMHR=0 F S AMHR=$O(^AMHREC("AE",DFN,AMHSD,AMHR)) Q:AMHR'=+AMHR D
  1. ..Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHR)
  1. ..S AMHRCNT=AMHRCNT+1 ;COUNT # VISITS
  1. ..;TABLE LOC SEEN
  1. ..I $P(^AMHREC(AMHR,0),U,4)]"",'$D(AMHRLOC($P(^DIC(4,$P(^(0),U,4),0),U))) S AMHRLOC($P(^DIC(4,$P(^AMHREC(AMHR,0),U,4),0),U))=""
  1. ..;TABLE PROVIDERS
  1. ..S AMHP=0 F S AMHP=$O(^AMHRPROV("AD",AMHR,AMHP)) Q:AMHP'=+AMHP S P=$P(^AMHRPROV(AMHP,0),U),AMHPRV($P(^VA(200,P,0),U))=""
  1. ..;TABLE PROBLEMS
  1. ..S AMHP=0 F S AMHP=$O(^AMHRPRO("AD",AMHR,AMHP)) Q:AMHP'=+AMHP S P=$P(^AMHRPRO(AMHP,0),U),AMHPROB($P(^AMHPROB(P,0),U))=""
  1. ..Q
  1. .Q
  1. K AMHLINE,AMHPRNT,AMHPCNT,AMHPRNM
  1. S AMHLINE(1)=""
  1. S X="",C=0,K=11 F S X=$O(AMHRLOC(X)) Q:X="" S C=C+1,AMHPRNM(C)=X
  1. D LINE
  1. K AMHPRNM S X="",C=0,K=11 F S X=$O(AMHPRV(X)) Q:X="" S C=C+1,AMHPRNM(C)=X
  1. D LINE
  1. K AMHPRNM S X="",C=0,K=9 F S X=$O(AMHPROB(X)) Q:X="" S C=C+1,AMHPRNM(C)=X
  1. D LINE
  1. S AMHRCNT=$J(AMHRCNT,4),AMHLINE(1)=AMHLINE(1)_AMHRCNT,X=0 F S X=$O(AMHLINE(X)) Q:X'=+X W ?41,AMHLINE(X),!
  1. Q
  1. LINE ;
  1. I '$D(AMHPRNM) S AMHPRNT="--" D
  1. .S AMHPRNT=$E(AMHPRNT,1,10) D
  1. ..S J=$L(AMHPRNT),AMHLINE(1)=AMHLINE(1)_AMHPRNT F I=J:1:K S AMHLINE(1)=AMHLINE(1)_" "
  1. S X=0 F S X=$O(AMHPRNM(X)) Q:X'=+X D
  1. .I X=1 D Q
  1. ..S AMHPRNT=$E(AMHPRNM(1),1,10) D
  1. ...S J=$L(AMHPRNT),AMHLINE(1)=AMHLINE(1)_AMHPRNT F I=J:1:K S AMHLINE(1)=AMHLINE(1)_" "
  1. .S AMHPRNT=$E(AMHPRNM(X),1,10) D
  1. ..I '$D(AMHLINE(X)) S AMHLINE(X)="",$P(AMHLINE(X)," ",($L(AMHLINE(1))-K))=""
  1. ..S J=$L(AMHPRNT),AMHLINE(X)=AMHLINE(X)_AMHPRNT F I=J:1:K S AMHLINE(X)=AMHLINE(X)_" "
  1. S X=1 F S X=$O(AMHLINE(X)) Q:X'=+X I $L(AMHLINE(X))<$L(AMHLINE(1)) S K=$L(AMHLINE(X))+1,J=$L(AMHLINE(1)) F I=K:1:J S AMHLINE(X)=AMHLINE(X)_" "
  1. Q
  1. I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQ="" Q
  1. HEAD1 ;
  1. W:$D(IOF) @IOF S AMHPG=AMHPG+1
  1. W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
  1. W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",AMHPG,!
  1. W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),!
  1. W ?31,"ACTIVE CLIENT LIST"
  1. S AMHLENG=$S(AMHPROV:$L($P(^VA(200,AMHPROV,0),U)),1:3)+10
  1. W !?((80-AMHLENG)/2),"PROVIDER: ",$S('AMHPROV:"ALL",1:$P(^VA(200,AMHPROV,0),U)),!
  1. W ?15,"ENCOUNTER DATES: ",AMHBDD," TO ",AMHEDD,!
  1. PIH W !,"PATIENT NAME",?18,"CHART",?26,"SEX",?31,"DOB",?41,"LOCATION",?53,"PROVIDER",?65,"PROBLEM",?76,"#"
  1. W !?18,"NUMBER",?41,"SEEN",?53,"SEEN",?65,"CODES",?73,"VISITS",!,AMH80D
  1. Q