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