AMHLESAN ; IHS/CMI/LAB - DISPLAY/EDIT TREATMENT NOTES ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
;; ;
EN ; EP -- main entry point for AMH UPDATE ACTIVITY RECORDS
S VALMCC=1
D EN^VALM("AMH SAN UPDATE")
D CLEAR^VALM1
Q
;
EP1(DFN,AMHR) ;EP CALLED FROM PROTOCOL
Q:'$G(AMHR)
Q:'$D(^AMHREC(AMHR))
I $G(AMHVTYPE)="" S AMHVTYPE=$P(^AMHREC(AMHR,0),U,33)
;get intake document or create new one
D EN
D FULL^VALM1
K VALMHDR
K X,Y
Q
BACK ;go back to listman
D TERM^VALM0
S VALMBCK="R"
D INIT
D HDR
K DIR
K X,Y,Z,I
Q
SELECT ;
W ! S DIR(0)="LO^1:"_$S(AMHVTYPE="S":21,1:8),DIR("A")="Which item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No items selected." G BACK
I $D(DIRUT) W !,"No items selected." G BACK
S AMHY=Y
D FULL^VALM1 W:$D(IOF) @IOF
S AMHC="" F AMHI=1:1 S AMHC=$P(AMHY,",",AMHI) Q:AMHC="" D
.I AMHVTYPE="S" S AMHX=$T(@AMHC)
.I AMHVTYPE="U" S Y=AMHC+70 S AMHX=$T(@Y)
.S AMHX1=$P(AMHX,";;",3),AMHX2=$P(AMHX,";;",4)
.D @AMHX1 Q
.Q
D BACK
Q
D ;
W !
D ^XBFMK S DA=AMHR,DIE="^AMHREC(",DR=AMHX2 D ^DIE D ^XBFMK
Q
GATHER ;EP - called from AMHUAR
K AMHQUIT,AMHLESAN S AMHRCNT=0,AMHLINE=0
I AMHVTYPE="U" D GATHER1 Q
F AMHE=1:1:21 D
.S X=$T(@AMHE)
.S AMHRCNT=AMHRCNT+1,AMHLINE=AMHLINE+1,AMHLESAN(AMHLINE,0)=$P(X,";;",1)_" "_$P(X,";;",2),AMHLESAN("IDX",AMHRCNT,AMHLINE)=AMHLINE
.Q
Q
HDR ;EP -- header code
S VALMHDR(1)="Patient Name: "_$P(^DPT(DFN,0),U)_" DOB: "_$$FTIME^VALM1($P(^DPT(DFN,0),U,3))_" Sex: "_$P(^DPT(DFN,0),U,2)
Q
;
GATHER1 ;
F AMHE=71:1:78 D
.S X=$T(@AMHE)
.S AMHRCNT=AMHRCNT+1,AMHLINE=AMHLINE+1,AMHLESAN(AMHLINE,0)=$P(X,";;",1)-70_" "_$P(X,";;",2),AMHLESAN("IDX",AMHRCNT,AMHLINE)=AMHLINE
.Q
Q
INIT ;EP -- init variables and list array
D GATHER ;gather up all records for display
S VALMCNT=AMHLINE
Q
;
HELP ;EP -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
DISP ;
D EN^AMHLESA1(AMHR)
D BACK
Q
EXIT ; -- exit code
K AMHRCNT,AMHPTP,AMHE,AMHLINE,AMHLEL,AMHLETXT,AMHGNUM,AMHTPN,AMHCOL
K VALMCC,VALMHDR
Q
;
EXPND ; -- expand code
Q
1 ;;Parents;;D;;7701
2 ;;Guardians;;D;;7702
3 ;;Lives With;;D;;7703
4 ;;Spouse/Partner Info;;D;;7704
5 ;;Person Referring Info;;D;;7706
6 ;;Relation To Victim;;D;;7707
7 ;;Suspected Perpetrator Info;;D;;7901
8 ;;History;;D;;7709
9 ;;Prior Incidents Noted;;D;;7717
10 ;;Assessment: Problems Identified;;D;;7711
11 ;;Assessment: Strengths Identified;;D;;7712
12 ;;Risk for Recurrence;;D;;7713
13 ;;Services Provided/Treatment Plan;;D;;7715
14 ;;Examining Physician;;D;;7902
15 ;;Date of Examination;;D;;7719
16 ;;Police Contacted: Y/N;;D;;7721
17 ;;Date/Time Complaint Filed;;D;;7722
18 ;;Complaint #;;D;;7903
19 ;;Officer Name and Agency;;D;;7904
20 ;;Referral(s) Made to;;D;;7905
21 ;;Other Comments;;D;;7724
;
;
71 ;;Reasons for Review;;D;;7801
72 ;;Outcome;;D;;7802
73 ;;Outcome Reasons;;D;;7803
74 ;;Assessment: Problems Identified;;D;;7804
75 ;;Assessment: Strengths Identified;;D;;7805
76 ;;Risk;;D;;7806
77 ;;Services Provided up to time of review;;D;;7808
78 ;;Recommendations/Comments;;D;;7809
AMHLESAN ; IHS/CMI/LAB - DISPLAY/EDIT TREATMENT NOTES ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
+5 ;; ;
EN ; EP -- main entry point for AMH UPDATE ACTIVITY RECORDS
+1 SET VALMCC=1
+2 DO EN^VALM("AMH SAN UPDATE")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
EP1(DFN,AMHR) ;EP CALLED FROM PROTOCOL
+1 IF '$GET(AMHR)
QUIT
+2 IF '$DATA(^AMHREC(AMHR))
QUIT
+3 IF $GET(AMHVTYPE)=""
SET AMHVTYPE=$PIECE(^AMHREC(AMHR,0),U,33)
+4 ;get intake document or create new one
+5 DO EN
+6 DO FULL^VALM1
+7 KILL VALMHDR
+8 KILL X,Y
+9 QUIT
BACK ;go back to listman
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO INIT
+4 DO HDR
+5 KILL DIR
+6 KILL X,Y,Z,I
+7 QUIT
SELECT ;
+1 WRITE !
SET DIR(0)="LO^1:"_$SELECT(AMHVTYPE="S":21,1:8)
SET DIR("A")="Which item(s)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF Y=""
WRITE !,"No items selected."
GOTO BACK
+3 IF $DATA(DIRUT)
WRITE !,"No items selected."
GOTO BACK
+4 SET AMHY=Y
+5 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+6 SET AMHC=""
FOR AMHI=1:1
SET AMHC=$PIECE(AMHY,",",AMHI)
IF AMHC=""
QUIT
Begin DoDot:1
+7 IF AMHVTYPE="S"
SET AMHX=$TEXT(@AMHC)
+8 IF AMHVTYPE="U"
SET Y=AMHC+70
SET AMHX=$TEXT(@Y)
+9 SET AMHX1=$PIECE(AMHX,";;",3)
SET AMHX2=$PIECE(AMHX,";;",4)
+10 DO @AMHX1
QUIT
+11 QUIT
End DoDot:1
+12 DO BACK
+13 QUIT
D ;
+1 WRITE !
+2 DO ^XBFMK
SET DA=AMHR
SET DIE="^AMHREC("
SET DR=AMHX2
DO ^DIE
DO ^XBFMK
+3 QUIT
GATHER ;EP - called from AMHUAR
+1 KILL AMHQUIT,AMHLESAN
SET AMHRCNT=0
SET AMHLINE=0
+2 IF AMHVTYPE="U"
DO GATHER1
QUIT
+3 FOR AMHE=1:1:21
Begin DoDot:1
+4 SET X=$TEXT(@AMHE)
+5 SET AMHRCNT=AMHRCNT+1
SET AMHLINE=AMHLINE+1
SET AMHLESAN(AMHLINE,0)=$PIECE(X,";;",1)_" "_$PIECE(X,";;",2)
SET AMHLESAN("IDX",AMHRCNT,AMHLINE)=AMHLINE
+6 QUIT
End DoDot:1
+7 QUIT
HDR ;EP -- header code
+1 SET VALMHDR(1)="Patient Name: "_$PIECE(^DPT(DFN,0),U)_" DOB: "_$$FTIME^VALM1($PIECE(^DPT(DFN,0),U,3))_" Sex: "_$PIECE(^DPT(DFN,0),U,2)
+2 QUIT
+3 ;
GATHER1 ;
+1 FOR AMHE=71:1:78
Begin DoDot:1
+2 SET X=$TEXT(@AMHE)
+3 SET AMHRCNT=AMHRCNT+1
SET AMHLINE=AMHLINE+1
SET AMHLESAN(AMHLINE,0)=$PIECE(X,";;",1)-70_" "_$PIECE(X,";;",2)
SET AMHLESAN("IDX",AMHRCNT,AMHLINE)=AMHLINE
+4 QUIT
End DoDot:1
+5 QUIT
INIT ;EP -- init variables and list array
+1 ;gather up all records for display
DO GATHER
+2 SET VALMCNT=AMHLINE
+3 QUIT
+4 ;
HELP ;EP -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
DISP ;
+1 DO EN^AMHLESA1(AMHR)
+2 DO BACK
+3 QUIT
EXIT ; -- exit code
+1 KILL AMHRCNT,AMHPTP,AMHE,AMHLINE,AMHLEL,AMHLETXT,AMHGNUM,AMHTPN,AMHCOL
+2 KILL VALMCC,VALMHDR
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
1 ;;Parents;;D;;7701
2 ;;Guardians;;D;;7702
3 ;;Lives With;;D;;7703
4 ;;Spouse/Partner Info;;D;;7704
5 ;;Person Referring Info;;D;;7706
6 ;;Relation To Victim;;D;;7707
7 ;;Suspected Perpetrator Info;;D;;7901
8 ;;History;;D;;7709
9 ;;Prior Incidents Noted;;D;;7717
10 ;;Assessment: Problems Identified;;D;;7711
11 ;;Assessment: Strengths Identified;;D;;7712
12 ;;Risk for Recurrence;;D;;7713
13 ;;Services Provided/Treatment Plan;;D;;7715
14 ;;Examining Physician;;D;;7902
15 ;;Date of Examination;;D;;7719
16 ;;Police Contacted: Y/N;;D;;7721
17 ;;Date/Time Complaint Filed;;D;;7722
18 ;;Complaint #;;D;;7903
19 ;;Officer Name and Agency;;D;;7904
20 ;;Referral(s) Made to;;D;;7905
21 ;;Other Comments;;D;;7724
+1 ;
+2 ;
71 ;;Reasons for Review;;D;;7801
72 ;;Outcome;;D;;7802
73 ;;Outcome Reasons;;D;;7803
74 ;;Assessment: Problems Identified;;D;;7804
75 ;;Assessment: Strengths Identified;;D;;7805
76 ;;Risk;;D;;7806
77 ;;Services Provided up to time of review;;D;;7808
78 ;;Recommendations/Comments;;D;;7809
