PXRMLPHS ; SLC/PJH,PKR - Run Health Summaries from Patient List ;03/26/2007
;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
;
;External Ref DBIA #398
;
HSA(LISTIEN) ;Run health summary for all patients on this patient list.
N HSIEN,PLNODE
;Initialise
D FULL^VALM1
;Reset screen mode
W IORESET
;
;Select Health Summary
D HSEL(.HSIEN) Q:$D(DTOUT)!$D(DUOUT)
;
S PLNODE="PXRMLPHS"_$J_$$NOW^XLFDT
K ^XTMP(PLNODE)
S ^XTMP(PLNODE,0)=$$FMADD^XLFDT(DT,2)_U_DT_"HSI LIST"
D SORT(LISTIEN,PLNODE)
D QUE(HSIEN,PLNODE)
Q
;
HSEL(IEN) ;Select Health Summary Type
N X,Y,DIC
HS1 S DIC=142,DIC(0)="QAEMZ"
S DIC("A")="Select HEALTH SUMMARY TYPE: "
W !
D ^DIC
I X="" W !,"A health summary type name must be entered" G HS1
I X=(U_U) S DTOUT=1
I Y=-1 S DUOUT=1
I $D(DTOUT)!$D(DUOUT) Q
;Return HS ien
S IEN=$P(Y,U)
Q
;
HSI(PLNODE) ;Print health summary for selected patients.
N HSIEN
;Initialise
D FULL^VALM1
;Reset screen mode
W IORESET
;
;Select Health Summary
D HSEL(.HSIEN) Q:$D(DTOUT)!$D(DUOUT)
D QUE(HSIEN,PLNODE)
Q
;
PRINT(HSIEN,PLNODE) ;Print HS for Patient List IEN
N DFN,DIROUT,SUB
;Print HS for each patient
S SUB=0
F S SUB=$O(^XTMP(PLNODE,SUB)) Q:(SUB="")!$D(DIROUT) D
.S DFN=^XTMP(PLNODE,SUB)
.D ENX^GMTSDVR(DFN,HSIEN,"","") ; DBIA #398
;
;Clear workfile
K ^XTMP(PLNODE)
Q
;
QUE(HSIEN,PLNODE) ;Determine whether the report should be queued.
N PXRMQUE,%ZIS,ZTDESC,ZTRTN,ZTSK,ZTSAVE
S %ZIS="M"
S ZTDESC="Patient List Health Summaries - print"
S ZTRTN="PRINT^PXRMLPHS(HSIEN,PLNODE)"
S ZTSAVE("HSIEN")=""
S ZTSAVE("PLNODE")=""
S PXRMQUE=$$DEVICE^PXRMXQUE(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS,1)
S VALMBCK="R"
Q
;
SORT(LISTIEN,PLNODE) ;Sort workfile as required
N DATA,DFN,IND,PNAME
;Build the list in alphabetical order.
S IND=0
F S IND=$O(^PXRMXP(810.5,LISTIEN,30,IND)) Q:'IND D
.S DATA=$G(^PXRMXP(810.5,LISTIEN,30,IND,0)) Q:DATA=""
.S DFN=$P(DATA,U) Q:'DFN
.;DBIA #10035
.S PNAME=$P(^DPT(DFN,0),U,1) Q:PNAME=""
.S ^XTMP(PLNODE,PNAME)=DFN
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMLPHS 2090 printed Sep 23, 2025@19:22:32 Page 2
PXRMLPHS ; SLC/PJH,PKR - Run Health Summaries from Patient List ;03/26/2007
+1 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123
+2 ;
+3 ;External Ref DBIA #398
+4 ;
HSA(LISTIEN) ;Run health summary for all patients on this patient list.
+1 NEW HSIEN,PLNODE
+2 ;Initialise
+3 DO FULL^VALM1
+4 ;Reset screen mode
+5 WRITE IORESET
+6 ;
+7 ;Select Health Summary
+8 DO HSEL(.HSIEN)
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+9 ;
+10 SET PLNODE="PXRMLPHS"_$JOB_$$NOW^XLFDT
+11 KILL ^XTMP(PLNODE)
+12 SET ^XTMP(PLNODE,0)=$$FMADD^XLFDT(DT,2)_U_DT_"HSI LIST"
+13 DO SORT(LISTIEN,PLNODE)
+14 DO QUE(HSIEN,PLNODE)
+15 QUIT
+16 ;
HSEL(IEN) ;Select Health Summary Type
+1 NEW X,Y,DIC
HS1 SET DIC=142
SET DIC(0)="QAEMZ"
+1 SET DIC("A")="Select HEALTH SUMMARY TYPE: "
+2 WRITE !
+3 DO ^DIC
+4 IF X=""
WRITE !,"A health summary type name must be entered"
GOTO HS1
+5 IF X=(U_U)
SET DTOUT=1
+6 IF Y=-1
SET DUOUT=1
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+8 ;Return HS ien
+9 SET IEN=$PIECE(Y,U)
+10 QUIT
+11 ;
HSI(PLNODE) ;Print health summary for selected patients.
+1 NEW HSIEN
+2 ;Initialise
+3 DO FULL^VALM1
+4 ;Reset screen mode
+5 WRITE IORESET
+6 ;
+7 ;Select Health Summary
+8 DO HSEL(.HSIEN)
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+9 DO QUE(HSIEN,PLNODE)
+10 QUIT
+11 ;
PRINT(HSIEN,PLNODE) ;Print HS for Patient List IEN
+1 NEW DFN,DIROUT,SUB
+2 ;Print HS for each patient
+3 SET SUB=0
+4 FOR
SET SUB=$ORDER(^XTMP(PLNODE,SUB))
if (SUB="")!$DATA(DIROUT)
QUIT
Begin DoDot:1
+5 SET DFN=^XTMP(PLNODE,SUB)
+6 ; DBIA #398
DO ENX^GMTSDVR(DFN,HSIEN,"","")
End DoDot:1
+7 ;
+8 ;Clear workfile
+9 KILL ^XTMP(PLNODE)
+10 QUIT
+11 ;
QUE(HSIEN,PLNODE) ;Determine whether the report should be queued.
+1 NEW PXRMQUE,%ZIS,ZTDESC,ZTRTN,ZTSK,ZTSAVE
+2 SET %ZIS="M"
+3 SET ZTDESC="Patient List Health Summaries - print"
+4 SET ZTRTN="PRINT^PXRMLPHS(HSIEN,PLNODE)"
+5 SET ZTSAVE("HSIEN")=""
+6 SET ZTSAVE("PLNODE")=""
+7 SET PXRMQUE=$$DEVICE^PXRMXQUE(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS,1)
+8 SET VALMBCK="R"
+9 QUIT
+10 ;
SORT(LISTIEN,PLNODE) ;Sort workfile as required
+1 NEW DATA,DFN,IND,PNAME
+2 ;Build the list in alphabetical order.
+3 SET IND=0
+4 FOR
SET IND=$ORDER(^PXRMXP(810.5,LISTIEN,30,IND))
if 'IND
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^PXRMXP(810.5,LISTIEN,30,IND,0))
if DATA=""
QUIT
+6 SET DFN=$PIECE(DATA,U)
if 'DFN
QUIT
+7 ;DBIA #10035
+8 SET PNAME=$PIECE(^DPT(DFN,0),U,1)
if PNAME=""
QUIT
+9 SET ^XTMP(PLNODE,PNAME)=DFN
End DoDot:1
+10 QUIT
+11 ;
