GMTSMHTC ;SLC/WAT - Driver for MH Treatment Coordinator component ;04/11/12 11:56
;;2.7;Health Summary;**99,104**;Oct 20, 1995;Build 38
;
Q
;
;;ICRs
;;10060 ^VA(200 FM only reads
;;2056 GETS^DIQ
;;5697 $$START^SCMCMHTC
;;
EN ; get MHTC
N GMTSMHTC,GMTSIEN,GMTSARR,GMTSOUT,GMTSERR,GMTSCNT
S GMTSCNT=1
S GMTSMHTC=$$START^SCMCMHTC(DFN) ;Retrieve Mental Health Provider
;GMTSMHTC=IEN^MHTC^Team Position^Role^Team
I +GMTSMHTC>0 D Q:$D(GMTSERR)
. S GMTSIEN=$P(GMTSMHTC,"^"),GMTSIEN=GMTSIEN_","
. D GETS^DIQ(200,GMTSIEN,".137;.138;.132",,"GMTSARR","GMTSERR")
. I $D(GMTSERR) D ERROR Q
. S GMTSOUT(GMTSCNT)=" MH Treatment Team: "_$P(GMTSMHTC,U,5),GMTSCNT=GMTSCNT+1
. S GMTSOUT(GMTSCNT)=" MH Treatment Coordinator: "_$P(GMTSMHTC,U,2),GMTSCNT=GMTSCNT+1
. S GMTSOUT(GMTSCNT)=" Office Phone: "_GMTSARR(200,GMTSIEN,.132),GMTSCNT=GMTSCNT+1
. S GMTSOUT(GMTSCNT)=" Analog Pager: "_GMTSARR(200,GMTSIEN,.137),GMTSCNT=GMTSCNT+1
. S GMTSOUT(GMTSCNT)=" Digital Pager: "_GMTSARR(200,GMTSIEN,.138)
I $D(GMTSOUT) D PRINT
K:$D(MHTC) MHTC K:$D(TPIEN) TPIEN ;needed to clean up as these are leftover from the call to SCMCMHTC
Q
PRINT ;SHOW MHTC
N I
D CKP^GMTSUP Q:$D(GMTSQIT)
F I=1:1:GMTSCNT D
.W GMTSOUT(I),!
Q
;
ERROR ;inform user
N ERRCNT S ERRCNT=""
S GMTSOUT(GMTSCNT)="An error has ocurred while processing your request.",GMTSCNT=GMTSCNT+1
S GMTSOUT(GMTSCNT)="Please try your request again. If the error continues",GMTSCNT=GMTSCNT+1
S GMTSOUT(GMTSCNT)="please contact IRM for assistance.",GMTSCNT=GMTSCNT+1
S GMTSOUT(GMTSCNT)="The error message is:"
I $P(GMTSERR("DIERR"),"^")=1 S GMTSCNT=GMTSCNT+1,GMTSOUT(GMTSCNT)=GMTSERR("DIERR",1)_": "_GMTSERR("DIERR",1,"TEXT",1) D PRINT Q
F S ERRCNT=$O(GMTSERR("DIERR",ERRCNT)) Q:+ERRCNT'>0 D
. S GMTSCNT=GMTSCNT+1
. S GMTSOUT(GMTSCNT)=GMTSERR("DIERR",ERRCNT)_": "_GMTSERR("DIERR",ERRCNT,"TEXT",ERRCNT)
D PRINT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSMHTC 1973 printed Dec 13, 2024@01:58:14 Page 2
GMTSMHTC ;SLC/WAT - Driver for MH Treatment Coordinator component ;04/11/12 11:56
+1 ;;2.7;Health Summary;**99,104**;Oct 20, 1995;Build 38
+2 ;
+3 QUIT
+4 ;
+5 ;;ICRs
+6 ;;10060 ^VA(200 FM only reads
+7 ;;2056 GETS^DIQ
+8 ;;5697 $$START^SCMCMHTC
+9 ;;
EN ; get MHTC
+1 NEW GMTSMHTC,GMTSIEN,GMTSARR,GMTSOUT,GMTSERR,GMTSCNT
+2 SET GMTSCNT=1
+3 ;Retrieve Mental Health Provider
SET GMTSMHTC=$$START^SCMCMHTC(DFN)
+4 ;GMTSMHTC=IEN^MHTC^Team Position^Role^Team
+5 IF +GMTSMHTC>0
Begin DoDot:1
+6 SET GMTSIEN=$PIECE(GMTSMHTC,"^")
SET GMTSIEN=GMTSIEN_","
+7 DO GETS^DIQ(200,GMTSIEN,".137;.138;.132",,"GMTSARR","GMTSERR")
+8 IF $DATA(GMTSERR)
DO ERROR
QUIT
+9 SET GMTSOUT(GMTSCNT)=" MH Treatment Team: "_$PIECE(GMTSMHTC,U,5)
SET GMTSCNT=GMTSCNT+1
+10 SET GMTSOUT(GMTSCNT)=" MH Treatment Coordinator: "_$PIECE(GMTSMHTC,U,2)
SET GMTSCNT=GMTSCNT+1
+11 SET GMTSOUT(GMTSCNT)=" Office Phone: "_GMTSARR(200,GMTSIEN,.132)
SET GMTSCNT=GMTSCNT+1
+12 SET GMTSOUT(GMTSCNT)=" Analog Pager: "_GMTSARR(200,GMTSIEN,.137)
SET GMTSCNT=GMTSCNT+1
+13 SET GMTSOUT(GMTSCNT)=" Digital Pager: "_GMTSARR(200,GMTSIEN,.138)
End DoDot:1
if $DATA(GMTSERR)
QUIT
+14 IF $DATA(GMTSOUT)
DO PRINT
+15 ;needed to clean up as these are leftover from the call to SCMCMHTC
if $DATA(MHTC)
KILL MHTC
if $DATA(TPIEN)
KILL TPIEN
+16 QUIT
PRINT ;SHOW MHTC
+1 NEW I
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+3 FOR I=1:1:GMTSCNT
Begin DoDot:1
+4 WRITE GMTSOUT(I),!
End DoDot:1
+5 QUIT
+6 ;
ERROR ;inform user
+1 NEW ERRCNT
SET ERRCNT=""
+2 SET GMTSOUT(GMTSCNT)="An error has ocurred while processing your request."
SET GMTSCNT=GMTSCNT+1
+3 SET GMTSOUT(GMTSCNT)="Please try your request again. If the error continues"
SET GMTSCNT=GMTSCNT+1
+4 SET GMTSOUT(GMTSCNT)="please contact IRM for assistance."
SET GMTSCNT=GMTSCNT+1
+5 SET GMTSOUT(GMTSCNT)="The error message is:"
+6 IF $PIECE(GMTSERR("DIERR"),"^")=1
SET GMTSCNT=GMTSCNT+1
SET GMTSOUT(GMTSCNT)=GMTSERR("DIERR",1)_": "_GMTSERR("DIERR",1,"TEXT",1)
DO PRINT
QUIT
+7 FOR
SET ERRCNT=$ORDER(GMTSERR("DIERR",ERRCNT))
if +ERRCNT'>0
QUIT
Begin DoDot:1
+8 SET GMTSCNT=GMTSCNT+1
+9 SET GMTSOUT(GMTSCNT)=GMTSERR("DIERR",ERRCNT)_": "_GMTSERR("DIERR",ERRCNT,"TEXT",ERRCNT)
End DoDot:1
+10 DO PRINT
+11 QUIT
+12 ;