BSDHSP ; IHS/ANMC/LJF - PRINT/BROWSE HEALTH SUMMARY ; [ 02/10/2005 4:07 PM ]
;;5.3;PIMS;**1002***;APR 26, 2002
;
I $T(EN^APCHS)="" W !!,"HEALTH SUMMARY PACKAGE NOT INSTALLED." D PAUSE^BDGF Q
;
NEW DFN,APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY
S DFN=$G(SDFN)
I '$D(SDFN) S DFN=+$$READ^BDGF("P^2:EMQZ","Select Patient")
Q:'DFN S APCHSPAT=DFN
;
D GETHSTYP Q:'$G(APCHSTYP) ;ask health summary type
;IHS/ITSC/WAR 2/2/2005 PATCH #1002 SPT issue dealing with HS
S BSDSPT=$O(^DGSL(38.1,DFN,"D",0))
I BSDSPT>0 D
.I $P(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)["Appointment Management" D
..S $P(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)="AM/Health Summary"
;
I $$BROWSE^BDGF="B" D EN Q ;view in browse mode
;IHS/ITSC/WAR 2/2/2005 PATCH #1002 SPT issue dealing with HS
; If they didn't browse (D EN, from above) then they printed it.
I BSDSPT>0 S $P(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)="AM/PrtHealth Summary"
D ZIS^BDGF("PQ","EN^APCHS","HEALTH SUMMARY","APCHSPAT;APCHSTYP") Q
;
;
EN ;EP; -- main entry point for list template BSDAM HS VIEW
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BSDAM HS VIEW")
D CLEAR^VALM1
Q
;
HDR ;EP; -- header code
Q
;
INIT ;EP; -- init variables and list array
NEW X S VALMCNT=0
K ^TMP("BSDHSP",$J),^TMP("BSDHSP1",$J)
D GUIR^XBLM("EN^APCHS","^TMP(""BSDHSP1"",$J,")
S X=0 F S X=$O(^TMP("BSDHSP1",$J,X)) Q:'X D
. S VALMCNT=X
. S ^TMP("BSDHSP",$J,X,0)=^TMP("BSDHSP1",$J,X)
K ^TMP("BSDHSP1",$J)
Q
;
HELP ;EP; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ;EP; -- exit code
K ^TMP("BSDHSP",$J)
Q
;
EXPND ;EP; -- expand code
Q
;
GETHSTYP ; -- ask user for health summary type
NEW DIC,X,Y
S DIC="^APCHSCTL(",DIC(0)="AEMQ"
;
; try to determine a default for question
; first based on current clinic
S X=$$GET1^DIQ(9009017.2,+$G(SDCLN),.05)
; next based on last one used by user
I X="",$D(^DISV(DUZ,"^APCHSCTL(")) D
. S Y=^("^APCHSCTL(") I $D(^APCHSCTL(Y,0)) S X=$P(^(0),U,1)
; last find default for whole facility
I X="",$D(^APCCCTRL(+$G(DUZ(2)),0)) S X=$$GET1^DIQ(9001000,DUZ(2),.03)
S:X="" X="ADULT REGULAR" S DIC("B")=X
D ^DIC K DIC Q:Y<1 S APCHSTYP=+Y
Q
BSDHSP ; IHS/ANMC/LJF - PRINT/BROWSE HEALTH SUMMARY ; [ 02/10/2005 4:07 PM ]
+1 ;;5.3;PIMS;**1002***;APR 26, 2002
+2 ;
+3 IF $TEXT(EN^APCHS)=""
WRITE !!,"HEALTH SUMMARY PACKAGE NOT INSTALLED."
DO PAUSE^BDGF
QUIT
+4 ;
+5 NEW DFN,APCHSPAT,APCHSTYP,APCHSTAT,APCHSMTY
+6 SET DFN=$GET(SDFN)
+7 IF '$DATA(SDFN)
SET DFN=+$$READ^BDGF("P^2:EMQZ","Select Patient")
+8 IF 'DFN
QUIT
SET APCHSPAT=DFN
+9 ;
+10 ;ask health summary type
DO GETHSTYP
IF '$GET(APCHSTYP)
QUIT
+11 ;IHS/ITSC/WAR 2/2/2005 PATCH #1002 SPT issue dealing with HS
+12 SET BSDSPT=$ORDER(^DGSL(38.1,DFN,"D",0))
+13 IF BSDSPT>0
Begin DoDot:1
+14 IF $PIECE(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)["Appointment Management"
Begin DoDot:2
+15 SET $PIECE(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)="AM/Health Summary"
End DoDot:2
End DoDot:1
+16 ;
+17 ;view in browse mode
IF $$BROWSE^BDGF="B"
DO EN
QUIT
+18 ;IHS/ITSC/WAR 2/2/2005 PATCH #1002 SPT issue dealing with HS
+19 ; If they didn't browse (D EN, from above) then they printed it.
+20 IF BSDSPT>0
SET $PIECE(^DGSL(38.1,DFN,"D",BSDSPT,0),U,3)="AM/PrtHealth Summary"
+21 DO ZIS^BDGF("PQ","EN^APCHS","HEALTH SUMMARY","APCHSPAT;APCHSTYP")
QUIT
+22 ;
+23 ;
EN ;EP; -- main entry point for list template BSDAM HS VIEW
+1 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+2 DO EN^VALM("BSDAM HS VIEW")
+3 DO CLEAR^VALM1
+4 QUIT
+5 ;
HDR ;EP; -- header code
+1 QUIT
+2 ;
INIT ;EP; -- init variables and list array
+1 NEW X
SET VALMCNT=0
+2 KILL ^TMP("BSDHSP",$JOB),^TMP("BSDHSP1",$JOB)
+3 DO GUIR^XBLM("EN^APCHS","^TMP(""BSDHSP1"",$J,")
+4 SET X=0
FOR
SET X=$ORDER(^TMP("BSDHSP1",$JOB,X))
IF 'X
QUIT
Begin DoDot:1
+5 SET VALMCNT=X
+6 SET ^TMP("BSDHSP",$JOB,X,0)=^TMP("BSDHSP1",$JOB,X)
End DoDot:1
+7 KILL ^TMP("BSDHSP1",$JOB)
+8 QUIT
+9 ;
HELP ;EP; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ;EP; -- exit code
+1 KILL ^TMP("BSDHSP",$JOB)
+2 QUIT
+3 ;
EXPND ;EP; -- expand code
+1 QUIT
+2 ;
GETHSTYP ; -- ask user for health summary type
+1 NEW DIC,X,Y
+2 SET DIC="^APCHSCTL("
SET DIC(0)="AEMQ"
+3 ;
+4 ; try to determine a default for question
+5 ; first based on current clinic
+6 SET X=$$GET1^DIQ(9009017.2,+$GET(SDCLN),.05)
+7 ; next based on last one used by user
+8 IF X=""
IF $DATA(^DISV(DUZ,"^APCHSCTL("))
Begin DoDot:1
+9 SET Y=^("^APCHSCTL(")
IF $DATA(^APCHSCTL(Y,0))
SET X=$PIECE(^(0),U,1)
End DoDot:1
+10 ; last find default for whole facility
+11 IF X=""
IF $DATA(^APCCCTRL(+$GET(DUZ(2)),0))
SET X=$$GET1^DIQ(9001000,DUZ(2),.03)
+12 IF X=""
SET X="ADULT REGULAR"
SET DIC("B")=X
+13 DO ^DIC
KILL DIC
IF Y<1
QUIT
SET APCHSTYP=+Y
+14 QUIT
