BDMPL ; IHS/CMI/LAB - PROBLEM LIST UPDATE ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**3,8**;JUN 14, 2007;Build 53
;
;
EOJ ;cleanup
D:$D(VALMWD) CLEAR^VALM1 ;clears out all list man stuff
K ^TMP($J,"BDMPL"),^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,BDMLOC,BDMPAT,BDMDATE,BDMPIEN,BDMAF,BDMPRB,APCDOVRR,BDMLOOK,BDMPDFN,APCDPLPT
Q
EN1 ;EP
EN ;EP main entry point for BDM PL PROBLEM LIST
S VALMCC=1 ;1 means screen mode, 0 means scrolling mode
D EN^VALM("BDM PCC PROBLEM LIST DISPLAY")
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,"BDMPL")
S APCDPLPT=DFN
D GATHER^APCDPL ;gather up all problems FROM PCC
S VALMCNT=APCDLINE
S BDMRCNT=APCDRCNT
M ^TMP($J,"BDMPL")=^TMP($J,"APCDPL")
;S VALMCNT=BDMLINE ;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,"BDMPL")
K BDMRCNT,BDMPL,BDMLINE,BDMX,BDMP0,BDMC,BDML,BDMLR,BDMPIEN,BDMAF,BDMPRB,APCDOVRR,BDMLOOK,BDMPDFN,BDMLOC,BDMDATE,APCDPLPT
K X,Y
K VALMHDR
Q
;
EXPND ; -- expand code
Q
GETPROB ;get record
S BDMPIEN=0
I 'BDMRCNT W !,"No problems to select." Q
S DIR(0)="N^1:"_BDMRCNT_":0",DIR("A")="Select Problem" KILL DA D ^DIR KILL DIR
I $D(DIRUT) W !!,"No Problem Selected" D PAUSE,EXIT Q
S BDMP=Y
S (X,Y)=0 F S X=$O(^TMP($J,"BDMPL","IDX",X)) Q:X'=+X!(BDMPIEN) I $O(^TMP($J,"BDMPL","IDX",X,0))=BDMP S Y=$O(^TMP($J,"BDMPL","IDX",X,0)),BDMPIEN=^TMP($J,"BDMPL","IDX",X,Y)
I '$D(^AUPNPROB(BDMPIEN,0)) W !,"Not a valid PCC PROBLEM." K BDMP S BDMPIEN=0 Q
D FULL^VALM1 ;give me full control of screen
Q
;
DD ;EP - called from protocol to display (DIQ) a problem in detail
NEW BDMPIEN
D GETPROB
I 'BDMPIEN D PAUSE,XIT Q
D DIQ^XBLM(9000011,BDMPIEN)
D XIT
Q
PAUSE ;EP
S DIR(0)="EO",DIR("A")="Press return to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
GETNUM(P) ;EP - get problem number given ien of problem entry
NEW N,F
S N=""
I 'P Q N
I '$D(^AUPNPROB(P,0)) Q N
S F=$P(^AUPNPROB(P,0),U,6)
S N=$S($P(^AUTTLOC(F,0),U,7)]"":$J($P(^(0),U,7),4),1:"??")_$P(^AUPNPROB(P,0),U,7)
Q N
XIT ;
K APCDOVRR
K DLAYGO
K APCDPIEN
D TERM^VALM0
S VALMBCK="R"
;D INIT^BDMPL
;S VALMCNT=BDMLINE
;D HDR^BDMPL
K BDMTEMP,BDMPRMT,BDMP,BDMPIEN,BDMAF,BDMF,BDMP0,BDMPRB,APCDLOOK,BDMPPTR
;D KDIE
Q
BDMPL ; IHS/CMI/LAB - PROBLEM LIST UPDATE ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,8**;JUN 14, 2007;Build 53
+2 ;
+3 ;
EOJ ;cleanup
+1 ;clears out all list man stuff
IF $DATA(VALMWD)
DO CLEAR^VALM1
+2 KILL ^TMP($JOB,"BDMPL"),^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,BDMLOC,BDMPAT,BDMDATE,BDMPIEN,BDMAF,BDMPRB,APCDOVRR,BDMLOOK,BDMPDFN,APCDPLPT
+6 QUIT
EN1 ;EP
EN ;EP main entry point for BDM PL PROBLEM LIST
+1 ;1 means screen mode, 0 means scrolling mode
SET VALMCC=1
+2 DO EN^VALM("BDM PCC PROBLEM LIST DISPLAY")
+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,"BDMPL")
+2 SET APCDPLPT=DFN
+3 ;gather up all problems FROM PCC
DO GATHER^APCDPL
+4 SET VALMCNT=APCDLINE
+5 SET BDMRCNT=APCDRCNT
+6 MERGE ^TMP($JOB,"BDMPL")=^TMP($JOB,"APCDPL")
+7 ;S VALMCNT=BDMLINE ;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,"BDMPL")
+2 KILL BDMRCNT,BDMPL,BDMLINE,BDMX,BDMP0,BDMC,BDML,BDMLR,BDMPIEN,BDMAF,BDMPRB,APCDOVRR,BDMLOOK,BDMPDFN,BDMLOC,BDMDATE,APCDPLPT
+3 KILL X,Y
+4 KILL VALMHDR
+5 QUIT
+6 ;
EXPND ; -- expand code
+1 QUIT
GETPROB ;get record
+1 SET BDMPIEN=0
+2 IF 'BDMRCNT
WRITE !,"No problems to select."
QUIT
+3 SET DIR(0)="N^1:"_BDMRCNT_":0"
SET DIR("A")="Select Problem"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
WRITE !!,"No Problem Selected"
DO PAUSE
DO EXIT
QUIT
+5 SET BDMP=Y
+6 SET (X,Y)=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMPL","IDX",X))
IF X'=+X!(BDMPIEN)
QUIT
IF $ORDER(^TMP($JOB,"BDMPL","IDX",X,0))=BDMP
SET Y=$ORDER(^TMP($JOB,"BDMPL","IDX",X,0))
SET BDMPIEN=^TMP($JOB,"BDMPL","IDX",X,Y)
+7 IF '$DATA(^AUPNPROB(BDMPIEN,0))
WRITE !,"Not a valid PCC PROBLEM."
KILL BDMP
SET BDMPIEN=0
QUIT
+8 ;give me full control of screen
DO FULL^VALM1
+9 QUIT
+10 ;
DD ;EP - called from protocol to display (DIQ) a problem in detail
+1 NEW BDMPIEN
+2 DO GETPROB
+3 IF 'BDMPIEN
DO PAUSE
DO XIT
QUIT
+4 DO DIQ^XBLM(9000011,BDMPIEN)
+5 DO XIT
+6 QUIT
PAUSE ;EP
+1 SET DIR(0)="EO"
SET DIR("A")="Press return to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 QUIT
GETNUM(P) ;EP - get problem number given ien of problem entry
+1 NEW N,F
+2 SET N=""
+3 IF 'P
QUIT N
+4 IF '$DATA(^AUPNPROB(P,0))
QUIT N
+5 SET F=$PIECE(^AUPNPROB(P,0),U,6)
+6 SET N=$SELECT($PIECE(^AUTTLOC(F,0),U,7)]"":$JUSTIFY($PIECE(^(0),U,7),4),1:"??")_$PIECE(^AUPNPROB(P,0),U,7)
+7 QUIT N
XIT ;
+1 KILL APCDOVRR
+2 KILL DLAYGO
+3 KILL APCDPIEN
+4 DO TERM^VALM0
+5 SET VALMBCK="R"
+6 ;D INIT^BDMPL
+7 ;S VALMCNT=BDMLINE
+8 ;D HDR^BDMPL
+9 KILL BDMTEMP,BDMPRMT,BDMP,BDMPIEN,BDMAF,BDMF,BDMP0,BDMPRB,APCDLOOK,BDMPPTR
+10 ;D KDIE
+11 QUIT
