- GMRCPOS1 ;SLC/DCM - Post init to move Services from file 123.5 to the orderable items file, 101.43, and orderables in file 101 to file 101.43 ;10/28/98 14:31
- ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
- EN ;Entry point
- D SVC,ITEMS
- Q
- SVC ;;get services from file 123.5, format them into an HL-7 message and send the message to OE/RR to update file 101.43
- S GMRCSSN="",GMRCSRN=0,RLEVCODE="MAD"
- F S GMRCSSN=$O(^GMR(123.5,"B",GMRCSSN)) Q:GMRCSSN="" S GMRCSRN=$O(^GMR(123.5,"B",GMRCSSN,0)) I $P(^GMR(123.5,GMRCSRN,0),"^",2)'=1,GMRCSSN'="ALL SERVICES" D
- .I $P(^GMR(123.5,GMRCSRN,0),"^",2)=9 S GMRCDC(GMRCSSN)=GMRCSRN
- .D SVC^GMRCPOST(GMRCSRN,GMRCSSN,RLEVCODE)
- .D MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
- .K GMRCMSG
- .Q
- S GMRCSSN="",GMRCSRN=0,RLEVCODE="MDC"
- F S GMRCSSN=$O(GMRCDC(GMRCSSN)) Q:GMRCSSN="" S GMRCSRN=GMRCDC(GMRCSSN) D
- .D SVC^GMRCPOST(GMRCSRN,GMRCSSN,RLEVCODE)
- .D MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
- .K GMRCMSG
- .Q
- K GMRCLCN,GMRCLSSN,GMRCSS,GMRCSSN,GMRCSRN,I,RLEVCODE,X
- Q
- ITEMS ;create an HL-7 message to move orderable items into the orderable items file - file 123.43 - and send it to oerr
- S GMRCMSTP="MFN",GMRCRELC="MAD"
- F PFX="GMRCR " D ;,"GMRCT " D
- .S GMRCPFX=PFX F S GMRCPFX=$O(^ORD(101,"B",GMRCPFX)) Q:$E(GMRCPFX,1,$L(PFX))'=PFX S ORIEN=$O(^ORD(101,"B",GMRCPFX,0)) D K GMRCARRY,GMRCMSG
- ..S GMRCPF1=$E(GMRCPFX,$L(PFX)+1,$L(GMRCPFX))
- ..Q:$E(GMRCPF1,1,6)="SAMPLE"
- ..S NO=0,NO1=1 F S NO=$O(^ORD(101,ORIEN,2,NO)) Q:NO?1A.E!(NO="") S SYN=^ORD(101,ORIEN,2,NO,0),GMRCARRY(NO1)=SYN,NO1=NO1+1
- ..D ITEMS^GMRCPOST(GMRCMSTP,GMRCRELC,ORIEN,GMRCPF1,.GMRCARRY,PFX)
- ..D MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
- ..Q
- .Q
- K GMRCMSTP,GMRCPF1,GMRCPFX,GMRCRELC,NO,NO1,ORIEN,PFX,SYN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCPOS1 1775 printed Feb 18, 2025@23:13:06 Page 2
- GMRCPOS1 ;SLC/DCM - Post init to move Services from file 123.5 to the orderable items file, 101.43, and orderables in file 101 to file 101.43 ;10/28/98 14:31
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
- EN ;Entry point
- +1 DO SVC
- DO ITEMS
- +2 QUIT
- SVC ;;get services from file 123.5, format them into an HL-7 message and send the message to OE/RR to update file 101.43
- +1 SET GMRCSSN=""
- SET GMRCSRN=0
- SET RLEVCODE="MAD"
- +2 FOR
- SET GMRCSSN=$ORDER(^GMR(123.5,"B",GMRCSSN))
- if GMRCSSN=""
- QUIT
- SET GMRCSRN=$ORDER(^GMR(123.5,"B",GMRCSSN,0))
- IF $PIECE(^GMR(123.5,GMRCSRN,0),"^",2)'=1
- IF GMRCSSN'="ALL SERVICES"
- Begin DoDot:1
- +3 IF $PIECE(^GMR(123.5,GMRCSRN,0),"^",2)=9
- SET GMRCDC(GMRCSSN)=GMRCSRN
- +4 DO SVC^GMRCPOST(GMRCSRN,GMRCSSN,RLEVCODE)
- +5 DO MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
- +6 KILL GMRCMSG
- +7 QUIT
- End DoDot:1
- +8 SET GMRCSSN=""
- SET GMRCSRN=0
- SET RLEVCODE="MDC"
- +9 FOR
- SET GMRCSSN=$ORDER(GMRCDC(GMRCSSN))
- if GMRCSSN=""
- QUIT
- SET GMRCSRN=GMRCDC(GMRCSSN)
- Begin DoDot:1
- +10 DO SVC^GMRCPOST(GMRCSRN,GMRCSSN,RLEVCODE)
- +11 DO MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
- +12 KILL GMRCMSG
- +13 QUIT
- End DoDot:1
- +14 KILL GMRCLCN,GMRCLSSN,GMRCSS,GMRCSSN,GMRCSRN,I,RLEVCODE,X
- +15 QUIT
- ITEMS ;create an HL-7 message to move orderable items into the orderable items file - file 123.43 - and send it to oerr
- +1 SET GMRCMSTP="MFN"
- SET GMRCRELC="MAD"
- +2 ;,"GMRCT " D
- FOR PFX="GMRCR "
- Begin DoDot:1
- +3 SET GMRCPFX=PFX
- FOR
- SET GMRCPFX=$ORDER(^ORD(101,"B",GMRCPFX))
- if $EXTRACT(GMRCPFX,1,$LENGTH(PFX))'=PFX
- QUIT
- SET ORIEN=$ORDER(^ORD(101,"B",GMRCPFX,0))
- Begin DoDot:2
- +4 SET GMRCPF1=$EXTRACT(GMRCPFX,$LENGTH(PFX)+1,$LENGTH(GMRCPFX))
- +5 if $EXTRACT(GMRCPF1,1,6)="SAMPLE"
- QUIT
- +6 SET NO=0
- SET NO1=1
- FOR
- SET NO=$ORDER(^ORD(101,ORIEN,2,NO))
- if NO?1A.E!(NO="")
- QUIT
- SET SYN=^ORD(101,ORIEN,2,NO,0)
- SET GMRCARRY(NO1)=SYN
- SET NO1=NO1+1
- +7 DO ITEMS^GMRCPOST(GMRCMSTP,GMRCRELC,ORIEN,GMRCPF1,.GMRCARRY,PFX)
- +8 DO MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
- +9 QUIT
- End DoDot:2
- KILL GMRCARRY,GMRCMSG
- +10 QUIT
- End DoDot:1
- +11 KILL GMRCMSTP,GMRCPF1,GMRCPFX,GMRCRELC,NO,NO1,ORIEN,PFX,SYN
- +12 QUIT