PXRMRPC ; SLC/PJH - PXRM REMINDER GUI - routine for RPC ;12/20/2000
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
Q
;
TAG(PXRMY,PXRMTAG,PXRMX) ;Entry point for all RPC calls
;
I PXRMTAG="ALL" D ALL(.PXRMY) Q
I PXRMTAG="INI" D INI(.PXRMY) Q
I PXRMTAG="INQ" D REMVAR^PXRMINQ(.PXRMY,PXRMX) Q
I PXRMTAG="EXC" D EXC(.PXRMY) Q
I PXRMTAG="CMP" D CMP(.PXRMY,PXRMX) Q
I PXRMTAG="RPC" D RPC(.PXRMY) Q
;
S PXRMY(1)="-1^INVALID"
;
Q
;
;
ALL(ORY) ;All active reminders
;print name^ien
N ARR,DATA,NAME,ORREM,OCNT,SUB
S ORREM=0
F S ORREM=$O(^PXD(811.9,ORREM)) Q:'ORREM D
.S DATA=$G(^PXD(811.9,ORREM,0)) Q:DATA=""
.;Skip inactive reminders
.I $P(DATA,U,6) Q
.;Skip reminders with no name
.S NAME=$P(DATA,U,3) I NAME="" Q
.;Sort by name
.S ARR(NAME_U_ORREM)=""
; Build output arrray
S SUB="",OCNT=0
F S SUB=$O(ARR(SUB)) Q:SUB="" D
.S OCNT=OCNT+1
.S ORY(OCNT)=SUB
Q
;
CMP(PXRMY,IEN) ;List Exchange Repository Entries
N CNT,DATA,CMPIEN,SUB
D CDISP^PXRMEXLC(IEN)
S CNT=0,SUB=""
F S SUB=$O(^TMP("PXRMEXLC",$J,SUB)) Q:'SUB D
.S DATA=$G(^TMP("PXRMEXLC",$J,SUB,0)) Q:DATA="" Q:DATA=" "
.S CMPIEN=$G(^TMP("PXRMEXLC",$J,"IDX",SUB,SUB))
.S CNT=CNT+1,PXRMY(CNT)=DATA_U_CMPIEN
Q
;
EXC(PXRMY) ;List Exchange Repository Entries
N CNT,DATA,REPIEN,SUB
D BLDLIST^PXRMEXLC(0)
S CNT=0,SUB=""
F S SUB=$O(^TMP("PXRMEXLR",$J,SUB)) Q:'SUB D
.S DATA=$G(^TMP("PXRMEXLR",$J,SUB,0)) Q:DATA=""
.S REPIEN=$G(^TMP("PXRMEXLR",$J,"IDX",SUB,SUB))
.S CNT=CNT+1,PXRMY(CNT)=$P(DATA," ",3,99)_U_REPIEN
Q
;
INI(PXRMY) ;Lists available RPC calls
;
S PXRMY(1)="Reminder Maintenance^ALL"
S PXRMY(2)="Reminder Exchange^EXC"
S PXRMY(3)="Test RPC^RPC"
S PXRMY(4)="Other Options^OTH"
Q
;
RPC(PXRMY) ;Test bed
;
D SEL^PXRMRPCD(.PXRMY)
Q
;
XALL(ORY,FROM,DIR) ;All active dialogs
;
; Input parameters
; FROM - dialog name
; DIR - direction (1/-1)
;
N CNT,DATA,DIEN,IC,TYPE
S CNT=44,IC=0
F Q:IC'<CNT S FROM=$O(^PXRMD(801.41,"B",FROM),DIR) Q:FROM="" D
.S DIEN=0
.F S DIEN=$O(^PXRMD(801.41,"B",FROM,DIEN)) Q:'DIEN D
..S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA=""
..;Only reminder dialogs
..S TYPE=$P(DATA,U,4) Q:TYPE'="R"
..;Skip diabled dialogs
..I $P(DATA,U,3)]"" Q
..;Sort by name
..S IC=IC+1,ORY(IC)=DIEN_U_FROM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMRPC 2329 printed Nov 22, 2024@16:59:04 Page 2
PXRMRPC ; SLC/PJH - PXRM REMINDER GUI - routine for RPC ;12/20/2000
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 QUIT
+3 ;
TAG(PXRMY,PXRMTAG,PXRMX) ;Entry point for all RPC calls
+1 ;
+2 IF PXRMTAG="ALL"
DO ALL(.PXRMY)
QUIT
+3 IF PXRMTAG="INI"
DO INI(.PXRMY)
QUIT
+4 IF PXRMTAG="INQ"
DO REMVAR^PXRMINQ(.PXRMY,PXRMX)
QUIT
+5 IF PXRMTAG="EXC"
DO EXC(.PXRMY)
QUIT
+6 IF PXRMTAG="CMP"
DO CMP(.PXRMY,PXRMX)
QUIT
+7 IF PXRMTAG="RPC"
DO RPC(.PXRMY)
QUIT
+8 ;
+9 SET PXRMY(1)="-1^INVALID"
+10 ;
+11 QUIT
+12 ;
+13 ;
ALL(ORY) ;All active reminders
+1 ;print name^ien
+2 NEW ARR,DATA,NAME,ORREM,OCNT,SUB
+3 SET ORREM=0
+4 FOR
SET ORREM=$ORDER(^PXD(811.9,ORREM))
if 'ORREM
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^PXD(811.9,ORREM,0))
if DATA=""
QUIT
+6 ;Skip inactive reminders
+7 IF $PIECE(DATA,U,6)
QUIT
+8 ;Skip reminders with no name
+9 SET NAME=$PIECE(DATA,U,3)
IF NAME=""
QUIT
+10 ;Sort by name
+11 SET ARR(NAME_U_ORREM)=""
End DoDot:1
+12 ; Build output arrray
+13 SET SUB=""
SET OCNT=0
+14 FOR
SET SUB=$ORDER(ARR(SUB))
if SUB=""
QUIT
Begin DoDot:1
+15 SET OCNT=OCNT+1
+16 SET ORY(OCNT)=SUB
End DoDot:1
+17 QUIT
+18 ;
CMP(PXRMY,IEN) ;List Exchange Repository Entries
+1 NEW CNT,DATA,CMPIEN,SUB
+2 DO CDISP^PXRMEXLC(IEN)
+3 SET CNT=0
SET SUB=""
+4 FOR
SET SUB=$ORDER(^TMP("PXRMEXLC",$JOB,SUB))
if 'SUB
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^TMP("PXRMEXLC",$JOB,SUB,0))
if DATA=""
QUIT
if DATA=" "
QUIT
+6 SET CMPIEN=$GET(^TMP("PXRMEXLC",$JOB,"IDX",SUB,SUB))
+7 SET CNT=CNT+1
SET PXRMY(CNT)=DATA_U_CMPIEN
End DoDot:1
+8 QUIT
+9 ;
EXC(PXRMY) ;List Exchange Repository Entries
+1 NEW CNT,DATA,REPIEN,SUB
+2 DO BLDLIST^PXRMEXLC(0)
+3 SET CNT=0
SET SUB=""
+4 FOR
SET SUB=$ORDER(^TMP("PXRMEXLR",$JOB,SUB))
if 'SUB
QUIT
Begin DoDot:1
+5 SET DATA=$GET(^TMP("PXRMEXLR",$JOB,SUB,0))
if DATA=""
QUIT
+6 SET REPIEN=$GET(^TMP("PXRMEXLR",$JOB,"IDX",SUB,SUB))
+7 SET CNT=CNT+1
SET PXRMY(CNT)=$PIECE(DATA," ",3,99)_U_REPIEN
End DoDot:1
+8 QUIT
+9 ;
INI(PXRMY) ;Lists available RPC calls
+1 ;
+2 SET PXRMY(1)="Reminder Maintenance^ALL"
+3 SET PXRMY(2)="Reminder Exchange^EXC"
+4 SET PXRMY(3)="Test RPC^RPC"
+5 SET PXRMY(4)="Other Options^OTH"
+6 QUIT
+7 ;
RPC(PXRMY) ;Test bed
+1 ;
+2 DO SEL^PXRMRPCD(.PXRMY)
+3 QUIT
+4 ;
XALL(ORY,FROM,DIR) ;All active dialogs
+1 ;
+2 ; Input parameters
+3 ; FROM - dialog name
+4 ; DIR - direction (1/-1)
+5 ;
+6 NEW CNT,DATA,DIEN,IC,TYPE
+7 SET CNT=44
SET IC=0
+8 FOR
if IC'<CNT
QUIT
SET FROM=$ORDER(^PXRMD(801.41,"B",FROM),DIR)
if FROM=""
QUIT
Begin DoDot:1
+9 SET DIEN=0
+10 FOR
SET DIEN=$ORDER(^PXRMD(801.41,"B",FROM,DIEN))
if 'DIEN
QUIT
Begin DoDot:2
+11 SET DATA=$GET(^PXRMD(801.41,DIEN,0))
if DATA=""
QUIT
+12 ;Only reminder dialogs
+13 SET TYPE=$PIECE(DATA,U,4)
if TYPE'="R"
QUIT
+14 ;Skip diabled dialogs
+15 IF $PIECE(DATA,U,3)]""
QUIT
+16 ;Sort by name
+17 SET IC=IC+1
SET ORY(IC)=DIEN_U_FROM
End DoDot:2
End DoDot:1
+18 QUIT
