BVPMAIN ; IHS/ITSC/LJF - VPR ENTRY POINT ;
;;1.0;VIEW PATIENT RECORD;;NOV 17, 2004
;
;This routine calls a list template to view a patient's record.
;The first screen displayed is the patient's health summary.
;
I '$$PKGCK^BVPU("APCHS","PCC HEALTH SUMMARY") D D EXIT Q
. D MSG^BVPU("**HEALTH SUMMARY SOFTWARE NOT INSTALLED**",2,1,1)
;
K ^TMP("BVP",$J) D KILL^AUPNPAT
F D GETPAT Q:$G(DFN)<1 D
. NEW APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,BVPSAV
. D GETHSTYP I '$G(APCHSTYP) D EXIT Q
. S APCHSPAT=DFN,BVPSAV=DFN
. D EN,FULL^VALM1,EXIT
;
EOJ ; -- end of job
D KILL^AUPNPAT,EN^XBVK("VALM"),EN^XBVK("APCH")
D KILL^%ZISS
Q
;
EN ;EP -- main entry point for list template BVP HS VIEW
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D MSG^BVPU("Building Health Summary Display. Please wait...",1,0,0)
D EN^VALM("BVP HS VIEW")
D CLEAR^VALM1
Q
;
HDR ;EP -- header code
S VALMSG=$$VALMSG^BVPU
Q
;
INIT ;EP -- init variables and list array
NEW X
K ^TMP("BVP",$J)
D GUIR^XBLM("EN^APCHS","^TMP(""BVP"",$J,")
S X=0 F S X=$O(^TMP("BVP",$J,X)) Q:'X D
. S VALMCNT=X
. S ^TMP("BVP",$J,X,0)=^TMP("BVP",$J,X)
D TERM^VALM0
S VALMSG=$$VALMSG^BVPU
Q
;
HELP ;EP -- help code
S X="?" D DISP^XQORM1,MSG^BVPU("",2,0,0)
Q
;
EXIT ;EP -- exit code
K ^TMP("BVP",$J)
K DFN,BVPSAV,APCHSPAT
Q
;
EXPND ;EP -- expand code
Q
;
RESET ;EP -- update partition for return to list manager
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D MSG^BVPU("Updating Health Summary Display. Please Wait...",1,0,0)
S DFN=BVPSAV D SETPT(DFN) ;make sure patient is still set
D INIT,HDR K BVPSECX Q
;
RESET2 ;EP -- update partition without recreating display array
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R" D HDR Q
;
GETPAT ; -- ask user to select patient
K DIC,DFN S DIC=9000001,DIC(0)="AEMQZ" D ^DIC I Y>0 S DFN=+Y K DIC,Y
Q
;
GETHSTYP ;EP -- ask user for health summary type
; Called by ^BVPVRL1
NEW DIC,DR,DD,X,Y
S DIC="^APCHSCTL(",DIC(0)="AEMQ"
; get default health summary type
S Y=$G(^DISV(DUZ,"^APCHSCTL(")) I $D(^APCHSCTL(+Y,0)) S DIC("B")=$P(^(0),U) ;last selected by user
I '$D(DIC("B")) S DIC("B")="VPR MINI" ;OR set to general HS type
D ^DIC K DIC Q:Y<1 S APCHSTYP=+Y
Q
;
VST ;EP -- view/edit pcc visits
; Called by BVP VISIT VIEW (Visit Details) protocol
D FULL^VALM1
S APCDPAT=DFN D GETVISIT^APCDDISP,^APCDVD,EOJ^APCDDISP
S (DFN,AUPNPAT)=BVPSAV D SETPT(DFN)
D RESET2
Q
;
HS ;EP; -- change health summary
; Called by BVP HS CHANGE (Change Health Summary) protocol
NEW BVPHS,X,Y
D FULL^VALM1
S BVPHS=APCHSTYP D GETHSTYP
I +$G(APCHSTYP)<1 S APCHSTYP=BVPHS D RESET2 Q
D EN^BVPMAIN S VALMBCK="Q"
Q
;
SETPT(DFN) ;EP; -- sets AUPN variables when DFN is set
NEW X,DIC,Y S X="`"_DFN,DIC=2,DIC(0)="" D ^DIC Q
BVPMAIN ; IHS/ITSC/LJF - VPR ENTRY POINT ;
+1 ;;1.0;VIEW PATIENT RECORD;;NOV 17, 2004
+2 ;
+3 ;This routine calls a list template to view a patient's record.
+4 ;The first screen displayed is the patient's health summary.
+5 ;
+6 IF '$$PKGCK^BVPU("APCHS","PCC HEALTH SUMMARY")
Begin DoDot:1
+7 DO MSG^BVPU("**HEALTH SUMMARY SOFTWARE NOT INSTALLED**",2,1,1)
End DoDot:1
DO EXIT
QUIT
+8 ;
+9 KILL ^TMP("BVP",$JOB)
DO KILL^AUPNPAT
+10 FOR
DO GETPAT
IF $GET(DFN)<1
QUIT
Begin DoDot:1
+11 NEW APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY,AMCHDAYS,AMCHDOB,BVPSAV
+12 DO GETHSTYP
IF '$GET(APCHSTYP)
DO EXIT
QUIT
+13 SET APCHSPAT=DFN
SET BVPSAV=DFN
+14 DO EN
DO FULL^VALM1
DO EXIT
End DoDot:1
+15 ;
EOJ ; -- end of job
+1 DO KILL^AUPNPAT
DO EN^XBVK("VALM")
DO EN^XBVK("APCH")
+2 DO KILL^%ZISS
+3 QUIT
+4 ;
EN ;EP -- main entry point for list template BVP HS VIEW
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO MSG^BVPU("Building Health Summary Display. Please wait...",1,0,0)
+3 DO EN^VALM("BVP HS VIEW")
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
HDR ;EP -- header code
+1 SET VALMSG=$$VALMSG^BVPU
+2 QUIT
+3 ;
INIT ;EP -- init variables and list array
+1 NEW X
+2 KILL ^TMP("BVP",$JOB)
+3 DO GUIR^XBLM("EN^APCHS","^TMP(""BVP"",$J,")
+4 SET X=0
FOR
SET X=$ORDER(^TMP("BVP",$JOB,X))
IF 'X
QUIT
Begin DoDot:1
+5 SET VALMCNT=X
+6 SET ^TMP("BVP",$JOB,X,0)=^TMP("BVP",$JOB,X)
End DoDot:1
+7 DO TERM^VALM0
+8 SET VALMSG=$$VALMSG^BVPU
+9 QUIT
+10 ;
HELP ;EP -- help code
+1 SET X="?"
DO DISP^XQORM1
DO MSG^BVPU("",2,0,0)
+2 QUIT
+3 ;
EXIT ;EP -- exit code
+1 KILL ^TMP("BVP",$JOB)
+2 KILL DFN,BVPSAV,APCHSPAT
+3 QUIT
+4 ;
EXPND ;EP -- expand code
+1 QUIT
+2 ;
RESET ;EP -- update partition for return to list manager
+1 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+2 DO TERM^VALM0
SET VALMBCK="R"
+3 DO MSG^BVPU("Updating Health Summary Display. Please Wait...",1,0,0)
+4 ;make sure patient is still set
SET DFN=BVPSAV
DO SETPT(DFN)
+5 DO INIT
DO HDR
KILL BVPSECX
QUIT
+6 ;
RESET2 ;EP -- update partition without recreating display array
+1 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+2 DO TERM^VALM0
SET VALMBCK="R"
DO HDR
QUIT
+3 ;
GETPAT ; -- ask user to select patient
+1 KILL DIC,DFN
SET DIC=9000001
SET DIC(0)="AEMQZ"
DO ^DIC
IF Y>0
SET DFN=+Y
KILL DIC,Y
+2 QUIT
+3 ;
GETHSTYP ;EP -- ask user for health summary type
+1 ; Called by ^BVPVRL1
+2 NEW DIC,DR,DD,X,Y
+3 SET DIC="^APCHSCTL("
SET DIC(0)="AEMQ"
+4 ; get default health summary type
+5 ;last selected by user
SET Y=$GET(^DISV(DUZ,"^APCHSCTL("))
IF $DATA(^APCHSCTL(+Y,0))
SET DIC("B")=$PIECE(^(0),U)
+6 ;OR set to general HS type
IF '$DATA(DIC("B"))
SET DIC("B")="VPR MINI"
+7 DO ^DIC
KILL DIC
IF Y<1
QUIT
SET APCHSTYP=+Y
+8 QUIT
+9 ;
VST ;EP -- view/edit pcc visits
+1 ; Called by BVP VISIT VIEW (Visit Details) protocol
+2 DO FULL^VALM1
+3 SET APCDPAT=DFN
DO GETVISIT^APCDDISP
DO ^APCDVD
DO EOJ^APCDDISP
+4 SET (DFN,AUPNPAT)=BVPSAV
DO SETPT(DFN)
+5 DO RESET2
+6 QUIT
+7 ;
HS ;EP; -- change health summary
+1 ; Called by BVP HS CHANGE (Change Health Summary) protocol
+2 NEW BVPHS,X,Y
+3 DO FULL^VALM1
+4 SET BVPHS=APCHSTYP
DO GETHSTYP
+5 IF +$GET(APCHSTYP)<1
SET APCHSTYP=BVPHS
DO RESET2
QUIT
+6 DO EN^BVPMAIN
SET VALMBCK="Q"
+7 QUIT
+8 ;
SETPT(DFN) ;EP; -- sets AUPN variables when DFN is set
+1 NEW X,DIC,Y
SET X="`"_DFN
SET DIC=2
SET DIC(0)=""
DO ^DIC
QUIT
