- AMHLETP4 ; IHS/CMI/LAB - MENTAL HLTH ROUTINE ;
- ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
- ;
- ;
- GATHER ;gather up and display all problems/goals/methods
- K ^TMP("AMHPTPP",$J)
- NEW AMHA,AMHB,AMHC,X,Y,Z,AMHL
- S (AMHA,AMHLINE,AMHRCNT)=0 F S AMHA=$O(^AMHPTPP("AD",AMHTP,AMHA)) Q:AMHA'=+AMHA S AMH0=^AMHPTPP(AMHA,0) D
- .S AMHRCNT=$G(AMHRCNT)+1
- .S X=AMHRCNT_") "_IORVON_"Problem: "_IORVOFF_IOINHI_$E($P(AMH0,U),1,44)_IOINORM,$E(X,60)="Status: "_$$VAL^XBDIQ1(9002011.62,AMHA,.12) D S S ^TMP("AMHPTPP",$J,"IDX",AMHRCNT,AMHLINE)=AMHA
- .S Y=0 F S Y=$O(^AMHPTPP(AMHA,11,Y)) Q:Y'=+Y S X="",$E(X,5)=^AMHPTPP(AMHA,11,Y,0) D S
- .S X=" Date Established: "_$$VAL^XBDIQ1(9002011.62,AMHA,.08),$E(X,42)="Established by: "_$E($$VAL^XBDIQ1(9002011.62,AMHA,.06),1,25) D S
- .S X=" Date Last Modified: "_$$VAL^XBDIQ1(9002011.62,AMHA,.08),$E(X,42)="Modified by: "_$E($$VAL^XBDIQ1(9002011.62,AMHA,.06),1,25) D S
- .Q
- Q ;*** new format
- WP ;EP - Entry point to print wp fields pass node in AMHNODE
- ;PASS FILE IN AMHFILE, ENTRY IN AMHDA
- NEW AMHX,AMHPCNT
- S AMHPCNT=0
- K AMHPRNM
- S AMHX=0 F S AMHX=$O(^AMHPTXP(AMHDA,AMHNODE,AMHX)) Q:AMHX'=+AMHX D
- .S AMHPCNT=AMHPCNT+1
- .S AMHPRNM(AMHPCNT)=^AMHPTXP(AMHDA,AMHNODE,AMHX,0)
- .Q
- Q
- NWP ;EP
- K ^UTILITY($J,"W")
- S AMHX=0
- S AMHG=$S($G(AMHG)]"":AMHG,1:^DIC(AMHFILE,0,"GL")),AMHG=AMHG_AMHDA_","_AMHNODE_",AMHX)"
- S DIWL=$S($G(AMHCOL):AMHCOL,1:1),DIWR=70 F S AMHX=$O(@AMHG) Q:AMHX'=+AMHX D
- .S Y=$P(AMHG,")")_",0)" S X=$TR(@Y,$C(10)) D ^DIWP
- .Q
- WPS ;EP
- S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z S AMHPCNT=AMHPCNT+1,AMHPRNM(AMHPCNT)=^UTILITY($J,"W",DIWL,Z,0)
- K DIWL,DIWR,DIWF,Z
- K ^UTILITY($J,"W"),AMHNODE,AMHFILE,AMHDA,AMHG,AMHCOL
- Q
- S ;
- S AMHLINE=AMHLINE+1
- S ^TMP("AMHPTPP",$J,AMHLINE,0)=X
- Q
- EOP ;
- W ! S DIR("A")="Press enter...",DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQUIT="" Q
- Q
- AMHLETP4 ; IHS/CMI/LAB - MENTAL HLTH ROUTINE ;
- +1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
- +2 ;
- +3 ;
- GATHER ;gather up and display all problems/goals/methods
- +1 KILL ^TMP("AMHPTPP",$JOB)
- +2 NEW AMHA,AMHB,AMHC,X,Y,Z,AMHL
- +3 SET (AMHA,AMHLINE,AMHRCNT)=0
- FOR
- SET AMHA=$ORDER(^AMHPTPP("AD",AMHTP,AMHA))
- IF AMHA'=+AMHA
- QUIT
- SET AMH0=^AMHPTPP(AMHA,0)
- Begin DoDot:1
- +4 SET AMHRCNT=$GET(AMHRCNT)+1
- +5 SET X=AMHRCNT_") "_IORVON_"Problem: "_IORVOFF_IOINHI_$EXTRACT($PIECE(AMH0,U),1,44)_IOINORM
- SET $EXTRACT(X,60)="Status: "_$$VAL^XBDIQ1(9002011.62,AMHA,.12)
- DO S
- SET ^TMP("AMHPTPP",$JOB,"IDX",AMHRCNT,AMHLINE)=AMHA
- +6 SET Y=0
- FOR
- SET Y=$ORDER(^AMHPTPP(AMHA,11,Y))
- IF Y'=+Y
- QUIT
- SET X=""
- SET $EXTRACT(X,5)=^AMHPTPP(AMHA,11,Y,0)
- DO S
- +7 SET X=" Date Established: "_$$VAL^XBDIQ1(9002011.62,AMHA,.08)
- SET $EXTRACT(X,42)="Established by: "_$EXTRACT($$VAL^XBDIQ1(9002011.62,AMHA,.06),1,25)
- DO S
- +8 SET X=" Date Last Modified: "_$$VAL^XBDIQ1(9002011.62,AMHA,.08)
- SET $EXTRACT(X,42)="Modified by: "_$EXTRACT($$VAL^XBDIQ1(9002011.62,AMHA,.06),1,25)
- DO S
- +9 QUIT
- End DoDot:1
- +10 ;*** new format
- QUIT
- WP ;EP - Entry point to print wp fields pass node in AMHNODE
- +1 ;PASS FILE IN AMHFILE, ENTRY IN AMHDA
- +2 NEW AMHX,AMHPCNT
- +3 SET AMHPCNT=0
- +4 KILL AMHPRNM
- +5 SET AMHX=0
- FOR
- SET AMHX=$ORDER(^AMHPTXP(AMHDA,AMHNODE,AMHX))
- IF AMHX'=+AMHX
- QUIT
- Begin DoDot:1
- +6 SET AMHPCNT=AMHPCNT+1
- +7 SET AMHPRNM(AMHPCNT)=^AMHPTXP(AMHDA,AMHNODE,AMHX,0)
- +8 QUIT
- End DoDot:1
- +9 QUIT
- NWP ;EP
- +1 KILL ^UTILITY($JOB,"W")
- +2 SET AMHX=0
- +3 SET AMHG=$SELECT($GET(AMHG)]"":AMHG,1:^DIC(AMHFILE,0,"GL"))
- SET AMHG=AMHG_AMHDA_","_AMHNODE_",AMHX)"
- +4 SET DIWL=$SELECT($GET(AMHCOL):AMHCOL,1:1)
- SET DIWR=70
- FOR
- SET AMHX=$ORDER(@AMHG)
- IF AMHX'=+AMHX
- QUIT
- Begin DoDot:1
- +5 SET Y=$PIECE(AMHG,")")_",0)"
- SET X=$TRANSLATE(@Y,$CHAR(10))
- DO ^DIWP
- +6 QUIT
- End DoDot:1
- WPS ;EP
- +1 SET Z=0
- FOR
- SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
- IF Z'=+Z
- QUIT
- SET AMHPCNT=AMHPCNT+1
- SET AMHPRNM(AMHPCNT)=^UTILITY($JOB,"W",DIWL,Z,0)
- +2 KILL DIWL,DIWR,DIWF,Z
- +3 KILL ^UTILITY($JOB,"W"),AMHNODE,AMHFILE,AMHDA,AMHG,AMHCOL
- +4 QUIT
- S ;
- +1 SET AMHLINE=AMHLINE+1
- +2 SET ^TMP("AMHPTPP",$JOB,AMHLINE,0)=X
- +3 QUIT
- EOP ;
- +1 WRITE !
- SET DIR("A")="Press enter..."
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET AMHQUIT=""
- QUIT
- +2 QUIT
