PXRMRPC.m

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 ---PXRMRPC   2329     printed  Feb 18, 2025@23:15:16                                                                                                                                                                                                     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