Routine: SDECGMR

SDECGMR ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017

 ;;5.3;Scheduling;**627,658**;Aug 13, 1993;Build 23

STOP(GMRSTOP,SDGMR)  ;get stop codes from field 688 of REQUEST SERVICES file 123.5

 ; .GMRSTOP - returned array of STOP CODE pointers to CLINIC STOP file 40.7

 ;            GMRSTOP(<clinic stop id>)=<clinic stop name>

 ;  SDGMR   - (required) pointer to REQUEST/CONSULTATION file 123

 N RS,SDDATA,SDI,SDIEN,SDNM

 K GMRSTOP

 S RS=$$GET1^DIQ(123,SDGMR_",",1,"I")  ;get TO SERVICE

 D GETS^DIQ(123.5,RS_",","688*","IE","SDDATA")

 S SDI=0 F  S SDI=$O(SDDATA(123.5688,SDI)) Q:SDI=""  D

 .S SDIEN=$G(SDDATA(123.5688,SDI,.01,"I"))

 .S SDNM=$G(SDDATA(123.5688,SDI,.01,"E"))

 .S:+SDIEN GMRSTOP(SDIEN)=SDNM

GETSVC(GMRSVC,SVC)  ;get REQUEST SERVICES entries for given stop codes

 ; .GMRSVC - returned array of REQUEST SERVICES entries

 ; .SVC    - input array of clinic stop codes SVC(NAME)=ID pointer to CLINIC STOP file 40.7

 N AB1,ID,SDN,STOP

 K GMRSVC

 S SDN="" F  S SDN=$O(SVC(SDN)) Q:SDN=""  D

 .I SVC(SDN)="" Q

 .S STOP=SVC(SDN) I '$D(^DIC(40.7,STOP,0)) Q

 .S ID=0 F  S ID=$O(^GMR(123.5,"AB1",STOP,ID)) Q:ID=""  D

 ..S AB1=0 F  S AB1=$O(^GMR(123.5,"AB1",STOP,ID,AB1)) Q:AB1=""  D

 ...Q:STOP'=$P($G(^GMR(123.5,ID,688,AB1,0)),U,1)

 ...S GMRSVC(ID)=""

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECGMR   1301     printed  Mar 13, 2025@21:57:09                                                                                                                                                                                                     Page 2

SDECGMR   ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017

 +1       ;;5.3;Scheduling;**627,658**;Aug 13, 1993;Build 23

 +2       ;

 +3        QUIT

 +4       ;

STOP(GMRSTOP,SDGMR) ;get stop codes from field 688 of REQUEST SERVICES file 123.5

 +1       ; .GMRSTOP - returned array of STOP CODE pointers to CLINIC STOP file 40.7

 +2       ;            GMRSTOP(<clinic stop id>)=<clinic stop name>

 +3       ;  SDGMR   - (required) pointer to REQUEST/CONSULTATION file 123

 +4        NEW RS,SDDATA,SDI,SDIEN,SDNM

 +5        KILL GMRSTOP

 +6       ;get TO SERVICE

           SET RS=$$GET1^DIQ(123,SDGMR_",",1,"I")

 +7        DO GETS^DIQ(123.5,RS_",","688*","IE","SDDATA")

 +8        SET SDI=0

FOR

               SET SDI=$ORDER(SDDATA(123.5688,SDI))

               if SDI=""

                   QUIT

               Begin DoDot:1

 +9                SET SDIEN=$GET(SDDATA(123.5688,SDI,.01,"I"))

 +10               SET SDNM=$GET(SDDATA(123.5688,SDI,.01,"E"))

 +11               if +SDIEN

                       SET GMRSTOP(SDIEN)=SDNM

               End DoDot:1

 +12       QUIT

 +13      ;

GETSVC(GMRSVC,SVC) ;get REQUEST SERVICES entries for given stop codes

 +1       ; .GMRSVC - returned array of REQUEST SERVICES entries

 +2       ; .SVC    - input array of clinic stop codes SVC(NAME)=ID pointer to CLINIC STOP file 40.7

 +3        NEW AB1,ID,SDN,STOP

 +4        KILL GMRSVC

 +5        SET SDN=""

FOR

               SET SDN=$ORDER(SVC(SDN))

               if SDN=""

                   QUIT

               Begin DoDot:1

 +6                IF SVC(SDN)=""

                       QUIT

 +7                SET STOP=SVC(SDN)

                   IF '$DATA(^DIC(40.7,STOP,0))

                       QUIT

 +8                SET ID=0

FOR

                       SET ID=$ORDER(^GMR(123.5,"AB1",STOP,ID))

                       if ID=""

                           QUIT

                       Begin DoDot:2

 +9                        SET AB1=0

FOR

                               SET AB1=$ORDER(^GMR(123.5,"AB1",STOP,ID,AB1))

                               if AB1=""

                                   QUIT

                               Begin DoDot:3

 +10                               if STOP'=$PIECE($GET(^GMR(123.5,ID,688,AB1,0)),U,1)

                                       QUIT

 +11                               SET GMRSVC(ID)=""

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +12       QUIT

SDECGMR.m