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
|
---|