SDECGMR ;ALB/SAT - VISTA SCHEDULING RPCS ;MAR 15, 2017
;;5.3;Scheduling;**627,658**;Aug 13, 1993;Build 23
;
Q
;
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
Q
;
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)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECGMR 1301 printed Dec 13, 2024@02:52:08 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
