AMHVU.m

AMHVU ; IHS/CMI/LAB - VIEW RECORD UTILITY CALLS ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 ;

INTRO ;EP; displays intro text to view reocrd

 D ^XBCLS

 D MSG($$SP(20)_"VIEW PATIENT'S RECORD",2,2,0)

 Q

 ;

CONFID(X) ;EP; -- SUBRTN to return confidential message

 Q "*****Confidential "_X_" Data Covered by Privacy Act*****"

 ;

RETURN ;EP; -- ask user to press ENTER

 Q:IOST'["C-"

 NEW Y S Y=$$READ("E","Press ENTER to continue") D ^XBCLS Q

 ;

VALMSG() ;EP; called to reset message line

 Q "- Previous Screen    QU Quit    ?? for More Actions"

 ;

VALMSG2() ;EP; called to reset message line

 Q "V=View Record   Q=Quit   ?? for More Actions"

 ;

VALMSG3() ;EP; called to reset message line

 Q "> Shift to Right  V View Record  ?? More Actions"

 ;

VALMSG4() ;EP; called to reset message line

 Q ">  Shift to Right  Q  Quit   ?? More Actions"

 ;

MSG(DATA,PRE,POST,BEEP) ;EP; -- writes line to device

 NEW I

 I PRE>0 F I=1:1:PRE W !

 W DATA

 I POST>0 F I=1:1:POST W !

 I $G(BEEP)>0 F I=1:1:BEEP W $C(7)

 Q

 ;

READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN,DIRA) ;EP; calls reader, returns response

 NEW DIR,X,Y

 S DIR(0)=TYPE

 I $D(SCREEN) S DIR("S")=SCREEN

 I $G(PROMPT)]"" S DIR("A")=PROMPT

 I $G(DEFAULT)]"" S DIR("B")=DEFAULT

 I $D(HELP) S DIR("?")=HELP

 I $D(DIRA(1)) S Y=0 F  S Y=$O(DIRA(Y)) Q:Y=""  S DIR("A",Y)=DIRA(Y)

 D ^DIR

 Q Y

 ;

PKGCK(RTN,MSG) ;EP; -- called to check if rtn and package are installed

 NEW X

 S X=RTN X ^%ZOSF("TEST") I '$T D  Q 0

 . Q:$G(MSG)=""

 . D MSG("Sorry, you do not have "_MSG_" software installed",1,1,1)

 . D RETURN

 Q 1

 ;

KEYCK(KEY,USER,MSG) ;EP; -- called to check is user has key

 I '$D(^XUSEC(KEY,USER)) D  Q 0

 . D MSG("Sorry, you do not have access to "_MSG,1,1,1)

 . D RETURN

 Q 1

 ;

LMKILL ;EP; -- kills IO and VALM variables used by List Manager

 D KILL^%ZISS

 K VALMIOXY,VALMWD,VALMHDR,VALMCC,VALMBCK,VALMSGR

 Q

PAD(D,L) ; -- SUBRTN to pad length of data

 ; -- D=data L=length

 Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)

 ;

SP(N) ; -- SUBRTN to pad N number of spaces

 Q $$PAD(" ",N)

AMHVU     ; IHS/CMI/LAB - VIEW RECORD UTILITY CALLS ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3       ;

INTRO     ;EP; displays intro text to view reocrd

 +1        DO ^XBCLS

 +2        DO MSG($$SP(20)_"VIEW PATIENT'S RECORD",2,2,0)

 +3        QUIT 

 +4       ;

CONFID(X) ;EP; -- SUBRTN to return confidential message

 +1        QUIT "*****Confidential "_X_" Data Covered by Privacy Act*****"

 +2       ;

RETURN    ;EP; -- ask user to press ENTER

 +1        IF IOST'["C-"

               QUIT 

 +2        NEW Y

           SET Y=$$READ("E","Press ENTER to continue")

           DO ^XBCLS

           QUIT 

 +3       ;

VALMSG()  ;EP; called to reset message line

 +1        QUIT "- Previous Screen    QU Quit    ?? for More Actions"

 +2       ;

VALMSG2() ;EP; called to reset message line

 +1        QUIT "V=View Record   Q=Quit   ?? for More Actions"

 +2       ;

VALMSG3() ;EP; called to reset message line

 +1        QUIT "> Shift to Right  V View Record  ?? More Actions"

 +2       ;

VALMSG4() ;EP; called to reset message line

 +1        QUIT ">  Shift to Right  Q  Quit   ?? More Actions"

 +2       ;

MSG(DATA,PRE,POST,BEEP) ;EP; -- writes line to device

 +1        NEW I

 +2        IF PRE>0

               FOR I=1:1:PRE

                   WRITE !

 +3        WRITE DATA

 +4        IF POST>0

               FOR I=1:1:POST

                   WRITE !

 +5        IF $GET(BEEP)>0

               FOR I=1:1:BEEP

                   WRITE $CHAR(7)

 +6        QUIT 

 +7       ;

READ(TYPE,PROMPT,DEFAULT,HELP,SCREEN,DIRA) ;EP; calls reader, returns response

 +1        NEW DIR,X,Y

 +2        SET DIR(0)=TYPE

 +3        IF $DATA(SCREEN)

               SET DIR("S")=SCREEN

 +4        IF $GET(PROMPT)]""

               SET DIR("A")=PROMPT

 +5        IF $GET(DEFAULT)]""

               SET DIR("B")=DEFAULT

 +6        IF $DATA(HELP)

               SET DIR("?")=HELP

 +7        IF $DATA(DIRA(1))

               SET Y=0

               FOR 

                   SET Y=$ORDER(DIRA(Y))

                   IF Y=""

                       QUIT 

                   SET DIR("A",Y)=DIRA(Y)

 +8        DO ^DIR

 +9        QUIT Y

 +10      ;

PKGCK(RTN,MSG) ;EP; -- called to check if rtn and package are installed

 +1        NEW X

 +2        SET X=RTN

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               Begin DoDot:1

 +3                IF $GET(MSG)=""

                       QUIT 

 +4                DO MSG("Sorry, you do not have "_MSG_" software installed",1,1,1)

 +5                DO RETURN

               End DoDot:1

               QUIT 0

 +6        QUIT 1

 +7       ;

KEYCK(KEY,USER,MSG) ;EP; -- called to check is user has key

 +1        IF '$DATA(^XUSEC(KEY,USER))

               Begin DoDot:1

 +2                DO MSG("Sorry, you do not have access to "_MSG,1,1,1)

 +3                DO RETURN

               End DoDot:1

               QUIT 0

 +4        QUIT 1

 +5       ;

LMKILL    ;EP; -- kills IO and VALM variables used by List Manager

 +1        DO KILL^%ZISS

 +2        KILL VALMIOXY,VALMWD,VALMHDR,VALMCC,VALMBCK,VALMSGR

 +3        QUIT 

PAD(D,L)  ; -- SUBRTN to pad length of data

 +1       ; -- D=data L=length

 +2        QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)

 +3       ;

SP(N)     ; -- SUBRTN to pad N number of spaces

 +1        QUIT $$PAD(" ",N)