PXRMRPCD ;SLC/PJH - PXRM REMINDER DIALOG ;Oct 23, 2018@06:19
;;2.0;CLINICAL REMINDERS;**16,45,65**;Feb 04, 2005;Build 438
;
; Used by CPRS - see DBIA #3295/#3296/#3332
;
;
CATEGORY(ORY,CIEN) ;Get category information
;
; Input parameter Category ien [#811.7]
;
N DATA,IC,IEN,NAME,PNAME,RIEN,SEQ,SUB,TEMP,USAGE
S IC=0
;Get category name
S NAME=$G(^PXRMD(811.7,CIEN,0)) I NAME="" Q
;
;Sort Reminders from this category into display sequence
S SUB=0 K TEMP
F S SUB=$O(^PXRMD(811.7,CIEN,2,SUB)) Q:SUB="" D
.S DATA=$G(^PXRMD(811.7,CIEN,2,SUB,0)) Q:DATA=""
.S RIEN=$P(DATA,U) Q:'RIEN
.S SEQ=$P(DATA,U,2)_0
.;Include only CPRS reminders
.S USAGE=$P($G(^PXD(811.9,RIEN,100)),U,4) I USAGE'["C",USAGE'["*" Q
.I USAGE["L"!(USAGE["O") Q
.;Skip inactive reminders
.S DATA=$G(^PXD(811.9,RIEN,0)) Q:DATA="" Q:$P(DATA,U,6)
.S NAME=$P(DATA,U) I NAME="" S NAME="Unknown"
.;or printname
.S PNAME=$P(DATA,U,3)
.S TEMP(SEQ)=RIEN_U_NAME_U_PNAME
;
;Re-save reminders in output array for display
;type^reminder ien^name
;
S SEQ=""
F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
.S IC=IC+1,ORY(IC)="R"_U_TEMP(SEQ)
;
;Sort Sub-Categories for this category into display order
S SUB=0 K TEMP
F S SUB=$O(^PXRMD(811.7,CIEN,10,SUB)) Q:SUB="" D
.S DATA=$G(^PXRMD(811.7,CIEN,10,SUB,0)) Q:DATA=""
.S IEN=$P(DATA,U) Q:'IEN
.S SEQ=$P(DATA,U,2),TEMP(SEQ)=IEN
;
;Save sub categories
S SEQ=""
F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
.S SUB=TEMP(SEQ) Q:'SUB
.S NAME=$P($G(^PXRMD(811.7,SUB,0)),U) Q:NAME=""
.S IC=IC+1,ORY(IC)="C"_U_SUB_U_NAME
Q
;
DIALOG(ORY,ORDLG,DFN,VISITID) ;Load dialog
;
; Input parameter ORDLG - dialog ien [#801.41]
;
I 'ORDLG S ORY(1)="-1^dialog ien not specified" Q
;
;Check if a reminder dialog and enabled
N DATA
S DATA=$G(^PXRMD(801.41,ORDLG,0))
;
I $P(DATA,U,4)'="R" S ORY(1)="-1^reminder dialog invalid" Q
;
I $P(DATA,U,3) S ORY(1)="-1^reminder dialog disabled" Q
;
;Load dialog lines into local array
D LOAD^PXRMDLL(ORDLG,$G(DFN),VISITID)
S ORY(0)=0_U_+$P($G(^PXRMD(801.41,ORDLG,0)),U,17)
Q
;
EDITPAR(PAR) ;Edit CPRS GUI Version 15 parameters
;
;This is an entry action in the PXRM CPRS CONFIGURATION menu options
;
;Check if Patch 85 has been installed
I '$$FIND1^DIC(8989.51,"","AMX",PAR) D Q
.W !!,"This option requires CPRS GUI Version 15" H 1
;
;Edit Parameter Definition
D EDITPAR^XPAREDIT(PAR)
Q
;
SEL(ORY) ;Selectable reminders and categories
N CIEN,CNAM,CNT,DATA,RCLASS,RNAM,RPNAM,RIEN,TYPE,USAGE
;
;Reminders in print name order
S TYPE="R",RPNAM="",CNT=0
F S RPNAM=$O(^PXD(811.9,"D",RPNAM)) Q:RPNAM="" D
.S RIEN=0
.F S RIEN=$O(^PXD(811.9,"D",RPNAM,RIEN)) Q:'RIEN D
..;Include only CPRS reminders
..S USAGE=$P($G(^PXD(811.9,RIEN,100)),U,4) I USAGE'["C",USAGE'["*" Q
..I USAGE["L"!(USAGE["O") Q
..;Skip inactive reminders
..S DATA=$G(^PXD(811.9,RIEN,0)) Q:DATA="" Q:$P(DATA,U,6)
..S RNAM=$P(DATA,U),RCLASS=$P($G(^PXD(811.9,RIEN,100)),U)
..S CNT=CNT+1,ORY(CNT)=TYPE_U_RIEN_U_RPNAM_U_RNAM_U_RCLASS
;
;Categories in name order
S TYPE="C",CNAM=""
F S CNAM=$O(^PXRMD(811.7,"B",CNAM)) Q:CNAM="" D
.S CIEN=$O(^PXRMD(811.7,"B",CNAM,"")) Q:'CIEN
.S CNT=CNT+1,ORY(CNT)=TYPE_U_CIEN_U_CNAM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMRPCD 3281 printed Oct 16, 2024@17:49:47 Page 2
PXRMRPCD ;SLC/PJH - PXRM REMINDER DIALOG ;Oct 23, 2018@06:19
+1 ;;2.0;CLINICAL REMINDERS;**16,45,65**;Feb 04, 2005;Build 438
+2 ;
+3 ; Used by CPRS - see DBIA #3295/#3296/#3332
+4 ;
+5 ;
CATEGORY(ORY,CIEN) ;Get category information
+1 ;
+2 ; Input parameter Category ien [#811.7]
+3 ;
+4 NEW DATA,IC,IEN,NAME,PNAME,RIEN,SEQ,SUB,TEMP,USAGE
+5 SET IC=0
+6 ;Get category name
+7 SET NAME=$GET(^PXRMD(811.7,CIEN,0))
IF NAME=""
QUIT
+8 ;
+9 ;Sort Reminders from this category into display sequence
+10 SET SUB=0
KILL TEMP
+11 FOR
SET SUB=$ORDER(^PXRMD(811.7,CIEN,2,SUB))
if SUB=""
QUIT
Begin DoDot:1
+12 SET DATA=$GET(^PXRMD(811.7,CIEN,2,SUB,0))
if DATA=""
QUIT
+13 SET RIEN=$PIECE(DATA,U)
if 'RIEN
QUIT
+14 SET SEQ=$PIECE(DATA,U,2)_0
+15 ;Include only CPRS reminders
+16 SET USAGE=$PIECE($GET(^PXD(811.9,RIEN,100)),U,4)
IF USAGE'["C"
IF USAGE'["*"
QUIT
+17 IF USAGE["L"!(USAGE["O")
QUIT
+18 ;Skip inactive reminders
+19 SET DATA=$GET(^PXD(811.9,RIEN,0))
if DATA=""
QUIT
if $PIECE(DATA,U,6)
QUIT
+20 SET NAME=$PIECE(DATA,U)
IF NAME=""
SET NAME="Unknown"
+21 ;or printname
+22 SET PNAME=$PIECE(DATA,U,3)
+23 SET TEMP(SEQ)=RIEN_U_NAME_U_PNAME
End DoDot:1
+24 ;
+25 ;Re-save reminders in output array for display
+26 ;type^reminder ien^name
+27 ;
+28 SET SEQ=""
+29 FOR
SET SEQ=$ORDER(TEMP(SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+30 SET IC=IC+1
SET ORY(IC)="R"_U_TEMP(SEQ)
End DoDot:1
+31 ;
+32 ;Sort Sub-Categories for this category into display order
+33 SET SUB=0
KILL TEMP
+34 FOR
SET SUB=$ORDER(^PXRMD(811.7,CIEN,10,SUB))
if SUB=""
QUIT
Begin DoDot:1
+35 SET DATA=$GET(^PXRMD(811.7,CIEN,10,SUB,0))
if DATA=""
QUIT
+36 SET IEN=$PIECE(DATA,U)
if 'IEN
QUIT
+37 SET SEQ=$PIECE(DATA,U,2)
SET TEMP(SEQ)=IEN
End DoDot:1
+38 ;
+39 ;Save sub categories
+40 SET SEQ=""
+41 FOR
SET SEQ=$ORDER(TEMP(SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+42 SET SUB=TEMP(SEQ)
if 'SUB
QUIT
+43 SET NAME=$PIECE($GET(^PXRMD(811.7,SUB,0)),U)
if NAME=""
QUIT
+44 SET IC=IC+1
SET ORY(IC)="C"_U_SUB_U_NAME
End DoDot:1
+45 QUIT
+46 ;
DIALOG(ORY,ORDLG,DFN,VISITID) ;Load dialog
+1 ;
+2 ; Input parameter ORDLG - dialog ien [#801.41]
+3 ;
+4 IF 'ORDLG
SET ORY(1)="-1^dialog ien not specified"
QUIT
+5 ;
+6 ;Check if a reminder dialog and enabled
+7 NEW DATA
+8 SET DATA=$GET(^PXRMD(801.41,ORDLG,0))
+9 ;
+10 IF $PIECE(DATA,U,4)'="R"
SET ORY(1)="-1^reminder dialog invalid"
QUIT
+11 ;
+12 IF $PIECE(DATA,U,3)
SET ORY(1)="-1^reminder dialog disabled"
QUIT
+13 ;
+14 ;Load dialog lines into local array
+15 DO LOAD^PXRMDLL(ORDLG,$GET(DFN),VISITID)
+16 SET ORY(0)=0_U_+$PIECE($GET(^PXRMD(801.41,ORDLG,0)),U,17)
+17 QUIT
+18 ;
EDITPAR(PAR) ;Edit CPRS GUI Version 15 parameters
+1 ;
+2 ;This is an entry action in the PXRM CPRS CONFIGURATION menu options
+3 ;
+4 ;Check if Patch 85 has been installed
+5 IF '$$FIND1^DIC(8989.51,"","AMX",PAR)
Begin DoDot:1
+6 WRITE !!,"This option requires CPRS GUI Version 15"
HANG 1
End DoDot:1
QUIT
+7 ;
+8 ;Edit Parameter Definition
+9 DO EDITPAR^XPAREDIT(PAR)
+10 QUIT
+11 ;
SEL(ORY) ;Selectable reminders and categories
+1 NEW CIEN,CNAM,CNT,DATA,RCLASS,RNAM,RPNAM,RIEN,TYPE,USAGE
+2 ;
+3 ;Reminders in print name order
+4 SET TYPE="R"
SET RPNAM=""
SET CNT=0
+5 FOR
SET RPNAM=$ORDER(^PXD(811.9,"D",RPNAM))
if RPNAM=""
QUIT
Begin DoDot:1
+6 SET RIEN=0
+7 FOR
SET RIEN=$ORDER(^PXD(811.9,"D",RPNAM,RIEN))
if 'RIEN
QUIT
Begin DoDot:2
+8 ;Include only CPRS reminders
+9 SET USAGE=$PIECE($GET(^PXD(811.9,RIEN,100)),U,4)
IF USAGE'["C"
IF USAGE'["*"
QUIT
+10 IF USAGE["L"!(USAGE["O")
QUIT
+11 ;Skip inactive reminders
+12 SET DATA=$GET(^PXD(811.9,RIEN,0))
if DATA=""
QUIT
if $PIECE(DATA,U,6)
QUIT
+13 SET RNAM=$PIECE(DATA,U)
SET RCLASS=$PIECE($GET(^PXD(811.9,RIEN,100)),U)
+14 SET CNT=CNT+1
SET ORY(CNT)=TYPE_U_RIEN_U_RPNAM_U_RNAM_U_RCLASS
End DoDot:2
End DoDot:1
+15 ;
+16 ;Categories in name order
+17 SET TYPE="C"
SET CNAM=""
+18 FOR
SET CNAM=$ORDER(^PXRMD(811.7,"B",CNAM))
if CNAM=""
QUIT
Begin DoDot:1
+19 SET CIEN=$ORDER(^PXRMD(811.7,"B",CNAM,""))
if 'CIEN
QUIT
+20 SET CNT=CNT+1
SET ORY(CNT)=TYPE_U_CIEN_U_CNAM
End DoDot:1
+21 QUIT
