AMHPL.m

AMHPL ; IHS/CMI/LAB - PROBLEM LIST UPDATE ;

 ;;4.0;IHS BEHAVIORAL HEALTH;**2,4**;JUN 18, 2010;Build 28

 ;; ;

 ;

EOJ ;cleanup

 D:$D(VALMWD) CLEAR^VALM1 ;clears out all list man stuff

 K ^TMP($J,"AMHPL"),^TMP($J,"APCDPL")

 D EN^XBVK("APCD")

 K XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF,VALMMCON,VALMDN,VALMEVL,VALMIOXY,VALMKEY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP,VALMWD,VALMY,XQORS,XQORSPEW

 K DFN,AMHLOC,AMHPAT,AMHDATE,AMHPIEN,AMHAF,AMHPRB,APCDOVRR,AMHLOOK,AMHPDFN,APCDPLPT

 Q

EN1 ;

EN ;EP  main entry point for AMH PL PROBLEM LIST

 S VALMCC=1 ;1 means screen mode, 0 means scrolling mode

 D EN^VALM("AMH PCC PROBLEM LIST")

 D CLEAR^VALM1

 Q

 ;

HDR ;EP -- header code

 S VALMHDR(1)=$TR($J(" ",80)," ","-")

 S VALMHDR(2)="Patient Name: "_IORVON_$P(^DPT(DFN,0),U)_IOINORM_"   DOB: "_$$FTIME^VALM1(AUPNDOB)_"   Sex: "_$P(^DPT(DFN,0),U,2)_"   HRN: "_$S($D(^AUPNPAT(DFN,41,DUZ(2),0)):$P(^AUPNPAT(DFN,41,DUZ(2),0),U,2),1:"????")

 S VALMHDR(3)=$TR($J(" ",80)," ","-")

 Q

 ;

INIT ; -- init variables and list array

 K ^TMP($J,"AMHPL")

 S APCDPLPT=DFN

 D GATHER^APCDPL ;gather up all problems FROM PCC

 S VALMCNT=APCDLINE

 S AMHRCNT=APCDRCNT

 M ^TMP($J,"AMHPL")=^TMP($J,"APCDPL")

 ;S VALMCNT=AMHLINE ;this variable must be the total number of lines in list

 S APCDOVRR="" ;for provider narrative lookup

 Q

 ;

TEXT ;

 ;;Patient Care Component (PCC)

 ;;

 ;;***********************************

 ;;*  View PCC Patient Problem List  *

 ;;***********************************

 ;;

 Q

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K ^TMP($J,"AMHPL")

 K AMHRCNT,AMHPL,AMHLINE,AMHX,AMHP0,AMHC,AMHL,AMHLR,AMHPIEN,AMHAF,AMHPRB,APCDOVRR,AMHLOOK,AMHPDFN,AMHLOC,AMHDATE,APCDPLPT

 K X,Y

 K VALMHDR

 Q

 ;

EXPND ; -- expand code

 Q

 ;

AMHPL     ; IHS/CMI/LAB - PROBLEM LIST UPDATE ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;**2,4**;JUN 18, 2010;Build 28

 +2       ;; ;

 +3       ;

EOJ       ;cleanup

 +1       ;clears out all list man stuff

           IF $DATA(VALMWD)

               DO CLEAR^VALM1

 +2        KILL ^TMP($JOB,"AMHPL"),^TMP($JOB,"APCDPL")

 +3        DO EN^XBVK("APCD")

 +4        KILL XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF,VALMMCON,VALMDN,VALMEVL,VALMIOXY,VALMKEY,VALMLFT,VALMLST,VALMMENU,VALMSGR,VALMUP,VALMWD,VALMY,XQORS,XQORSPEW

 +5        KILL DFN,AMHLOC,AMHPAT,AMHDATE,AMHPIEN,AMHAF,AMHPRB,APCDOVRR,AMHLOOK,AMHPDFN,APCDPLPT

 +6        QUIT 

EN1       ;

EN        ;EP  main entry point for AMH PL PROBLEM LIST

 +1       ;1 means screen mode, 0 means scrolling mode

           SET VALMCC=1

 +2        DO EN^VALM("AMH PCC PROBLEM LIST")

 +3        DO CLEAR^VALM1

 +4        QUIT 

 +5       ;

HDR       ;EP -- header code

 +1        SET VALMHDR(1)=$TRANSLATE($JUSTIFY(" ",80)," ","-")

 +2        SET VALMHDR(2)="Patient Name: "_IORVON_$PIECE(^DPT(DFN,0),U)_IOINORM_"   DOB: "_$$FTIME^VALM1(AUPNDOB)_"   Sex: "_$PIECE(^DPT(DFN,0),U,2)_"   HRN: "_$SELECT($DATA(^AUPNPAT(DFN,41,DUZ(2),0)):$PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,2),1:"????")

 +3        SET VALMHDR(3)=$TRANSLATE($JUSTIFY(" ",80)," ","-")

 +4        QUIT 

 +5       ;

INIT      ; -- init variables and list array

 +1        KILL ^TMP($JOB,"AMHPL")

 +2        SET APCDPLPT=DFN

 +3       ;gather up all problems FROM PCC

           DO GATHER^APCDPL

 +4        SET VALMCNT=APCDLINE

 +5        SET AMHRCNT=APCDRCNT

 +6        MERGE ^TMP($JOB,"AMHPL")=^TMP($JOB,"APCDPL")

 +7       ;S VALMCNT=AMHLINE ;this variable must be the total number of lines in list

 +8       ;for provider narrative lookup

           SET APCDOVRR=""

 +9        QUIT 

 +10      ;

TEXT      ;

 +1       ;;Patient Care Component (PCC)

 +2       ;;

 +3       ;;***********************************

 +4       ;;*  View PCC Patient Problem List  *

 +5       ;;***********************************

 +6       ;;

 +7        QUIT 

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP($JOB,"AMHPL")

 +2        KILL AMHRCNT,AMHPL,AMHLINE,AMHX,AMHP0,AMHC,AMHL,AMHLR,AMHPIEN,AMHAF,AMHPRB,APCDOVRR,AMHLOOK,AMHPDFN,AMHLOC,AMHDATE,APCDPLPT

 +3        KILL X,Y

 +4        KILL VALMHDR

 +5        QUIT 

 +6       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;