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  Sep 23, 2025@19:24:53                                                                                                                                                                                                     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