| 1 | 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
 | 
|---|
| 2 |  ;;3.0;CONSULT/REQUEST TRACKING;**1**;DEC 27, 1997
 | 
|---|
| 3 | EN ;Entry point
 | 
|---|
| 4 |  D SVC,ITEMS
 | 
|---|
| 5 |  Q
 | 
|---|
| 6 | 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
 | 
|---|
| 7 |  S GMRCSSN="",GMRCSRN=0,RLEVCODE="MAD"
 | 
|---|
| 8 |  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
 | 
|---|
| 9 |  .I $P(^GMR(123.5,GMRCSRN,0),"^",2)=9 S GMRCDC(GMRCSSN)=GMRCSRN
 | 
|---|
| 10 |  .D SVC^GMRCPOST(GMRCSRN,GMRCSSN,RLEVCODE)
 | 
|---|
| 11 |  .D MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
 | 
|---|
| 12 |  .K GMRCMSG
 | 
|---|
| 13 |  .Q
 | 
|---|
| 14 |  S GMRCSSN="",GMRCSRN=0,RLEVCODE="MDC"
 | 
|---|
| 15 |  F  S GMRCSSN=$O(GMRCDC(GMRCSSN)) Q:GMRCSSN=""  S GMRCSRN=GMRCDC(GMRCSSN) D
 | 
|---|
| 16 |  .D SVC^GMRCPOST(GMRCSRN,GMRCSSN,RLEVCODE)
 | 
|---|
| 17 |  .D MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
 | 
|---|
| 18 |  .K GMRCMSG
 | 
|---|
| 19 |  .Q
 | 
|---|
| 20 |  K GMRCLCN,GMRCLSSN,GMRCSS,GMRCSSN,GMRCSRN,I,RLEVCODE,X
 | 
|---|
| 21 |  Q
 | 
|---|
| 22 | ITEMS ;create an HL-7 message to move orderable items into the orderable items file - file 123.43 - and send it to oerr
 | 
|---|
| 23 |  S GMRCMSTP="MFN",GMRCRELC="MAD"
 | 
|---|
| 24 |  F PFX="GMRCR " D  ;,"GMRCT " D
 | 
|---|
| 25 |  .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
 | 
|---|
| 26 |  ..S GMRCPF1=$E(GMRCPFX,$L(PFX)+1,$L(GMRCPFX))
 | 
|---|
| 27 |  ..Q:$E(GMRCPF1,1,6)="SAMPLE"
 | 
|---|
| 28 |  ..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
 | 
|---|
| 29 |  ..D ITEMS^GMRCPOST(GMRCMSTP,GMRCRELC,ORIEN,GMRCPF1,.GMRCARRY,PFX)
 | 
|---|
| 30 |  ..D MSG^XQOR("GMRC ORDERABLE ITEM UPDATE",.GMRCMSG)
 | 
|---|
| 31 |  ..Q
 | 
|---|
| 32 |  .Q
 | 
|---|
| 33 |  K GMRCMSTP,GMRCPF1,GMRCPFX,GMRCRELC,NO,NO1,ORIEN,PFX,SYN
 | 
|---|
| 34 |  Q
 | 
|---|