- GMRCDST ;ABV/BL - Retrieve Decision from DST server;May 21, 2020@07:06:12
- ;;3.0;CONSULT/REQUEST TRACKING;**124,139,152,145,177**;DEC 27, 1997;Build 4
- ;
- ;SAC EXEMPTION 20200131-01 : GMRC use of vendor specific code
- ;IA6173
- ;IA6171
- ;
- PROT(MSG) ;GMRC SIGNED CONSULT DST-PROTOCOL ENTRY POINT
- ;
- ;Extract Order Number FROM THE ORC SEGMENT
- N GMRCMSG,GMRCPKG,MSH,ORC,IEN123,SIGN,ORA,X,SIGNED,DUP
- S GMRCMSG=$S($L($G(MSG)):MSG,1:"MSG") Q:'$O(@GMRCMSG@(0))
- S MSH=0 F S MSH=$O(@GMRCMSG@(MSH)) Q:MSH'>0 Q:$E(@GMRCMSG@(MSH),1,3)="MSH"
- Q:'MSH Q:'$L($G(@GMRCMSG@(MSH)))
- ;
- S ORC=MSH F S ORC=$O(@GMRCMSG@(+ORC)) Q:ORC'>0 I $E(@GMRCMSG@(ORC),1,3)="ORC" D
- . S ORC=ORC_U_@GMRCMSG@(ORC)
- . S ORIFN=+$P($P(ORC,"|",3),";")
- ;GET THE CONSULT IEN FROM THE ORDER
- S IEN123=0,X=$G(^OR(100,ORIFN,4)) I $P(X,";",2)="GMRC" S IEN123=+X
- I IEN123="" Q "-1^No Consult found"
- ;QUIT IF ORDER IS NOT SIGNED
- S ORA=0,SIGN=0,SIGNED=0
- F S ORA=$O(^OR(100,ORIFN,8,ORA)) Q:+ORA'=ORA!(SIGNED) D
- . S SIGN=$P(^OR(100,ORIFN,8,ORA,0),"^",6)
- . I SIGN>0 S SIGNED=1
- Q:SIGNED=0 "-1^ORDER NOT SIGNED"
- ;
- ;Need the DUZ of user from Order file for Autoforward
- K GMRCORNP
- S GMRCORNP=$$GET1^DIQ(100,ORIFN,3,"I")
- S ID=$$FINDIDO(ORIFN)
- I ID="" Q "-1^NO DST ID FOUND"
- I $P(ID,"^")="-1" Q "-1^NO DST DATA FOUND"
- ;Check if this DST Note has been added to the consult already
- ;is there an existing comment on the consult, check for duplicate ID
- S DUP=0
- I $D(^GMR(123,IEN123,40,0)) S DUP=$$DUPID(IEN123,ID)
- I DUP Q "-1^DST NOTE ALREADY ADDED TO CONSULT"
- ;
- Q $$GETDST(IEN123,ID)
- ;
- DUPID(IEN123,ID) ;Check to see if this ID has already been entered into the consult
- ;
- N CNODE,CINC,DUP,NOTEID,EDATA
- S DUP=0,CNODE=0,EDATA=0
- I IEN123="" Q DUP
- F S CNODE=$O(^GMR(123,IEN123,40,CNODE)) Q:+CNODE'=CNODE!(DUP) D
- . S CINC=0
- . F S CINC=$O(^GMR(123,IEN123,40,CNODE,1,CINC)) Q:CINC=""!(DUP) D
- . . I ^GMR(123,IEN123,40,CNODE,1,CINC,0)["CSC-Consult primary stop code:" S EDATA=1
- . . I ^GMR(123,IEN123,40,CNODE,1,CINC,0)["DST ID:" D
- . . . S NOTEID=""
- . . . S NOTEID=$P(^GMR(123,IEN123,40,CNODE,1,CINC,0),"DST ID:",2)
- . . . I NOTEID[ID S DUP=1
- ;Check if we have already loaded DST data
- ;If DUP is positive but EDATA=0 no data is actually loaded, set DUP to 0
- I 'EDATA S DUP=0
- Q DUP
- ;
- GETDST(IEN123,ID) ;
- ;This API retrieves the decision data from the DST database using ID
- ;Input:
- ; IEN123 The IEN of file #123
- ; ID The DST ID
- ;Output:
- ; If decision data not found: -1^No decision data found
- ; If decision data found: 1
- ;
- ;Autoforwarding variables added
- ; AFOR: Indicator of Autoforward value = DAF-DST Forwarding:
- ; APAY: Name of consult service from file 123.5 to forward to
- ;
- N A,B,CAPTIONS,COM,COMCT,DATA,I,SERVER,SERVICE,RESOURCE,REQUEST,RESPONSE,RESULT,RET,X,ERRFLG
- K NUMERR
- S ERRFLG=0,NUMERR=0
- S SERVER="DST GET ID SERVER"
- S SERVICE="DST GET ID SERVICE"
- I ID=0 Q "-1^NO VALID ID SUBMITTED"
- S RESOURCE="/"_ID
- ; Get an instance of the REST request object.
- S REQUEST=$$GETREST^XOBWLIB(SERVICE,SERVER)
- S REQUEST.Timeout=60
- S REQUEST.OpenTimeout=30
- ;
- TRYAG ; Execute the HTTP Get method.
- K XUERR,RESPJSON,AFOR,APAY,GMRCSS
- K COM ; WCJ;GMRC*3.0*177
- S ERRFLG=0 ; WCJ;GMRC*3.0*177
- S AFOR=0,APAY="" ;Set variable to check for AutoForward
- S RESULT=$$GET^XOBWLIB(REQUEST,RESOURCE,.XUERR,0)
- I 'RESULT D
- . S COM(1)="DVE-DST Error from VistA:" ;NEED TO WRITE ERROR TO 123 FILE
- . S COM(2)=XUERR.code
- . I XUERR["Http" S COM(3)=XUERR.statusLine
- . I XUERR["ObjectError" S COM(3)=XUERR.domain,COM(4)=XUERR.errorType
- . S ERRFLG=1,NUMERR=NUMERR+1
- ;If the ERRFLG then store the error in the consult
- I ERRFLG&(NUMERR<10) H 2 G TRYAG
- I ERRFLG D CMT^GMRCGUIB(IEN123,.COM,"",DT,DUZ) Q 0
- ; Process the response.
- S RESPONSE=REQUEST.HttpResponse
- S DATA=RESPONSE.Data
- ;code is not really in JSON format, not changing variable names
- S RESPJSON=""
- F Q:DATA.AtEnd Set RESPJSON=RESPJSON_DATA.ReadLine()
- S RESPJSON=$TR(RESPJSON,$C(10),"")
- ;current data is blob of text with ^ delimited fields. Put each field on its own line
- F I=1:1:$L(RESPJSON,"^") D
- . S COM(I)=$P(RESPJSON,"^",I)
- . I COM(I)="" K COM(I) Q ;BL;152 need to quit before checking for Autoforward
- . ;check for autoforwarding GMRC*3.0*139
- . I COM(I)["DAF-DST Forwarding:" D
- . . I $P(COM(I),":",2)["YES" S AFOR=1
- . I COM(I)["AFD-DST Forward to" D
- . . S APAY=$P(COM(I),":",2)
- . . I $E(APAY,1)=" " S APAY=$E(APAY,2,$L(APAY)) ;REMOVE LEADING SPACE FOR FORWARDED CONSULT
- ;If we have data in the COM array store in the Note, other wise quit with an error
- I $D(COM) D
- . ;COM ARRAY IS EXPECTED TO BE SERIALLY NUMBERED
- . N TCOM,COMNUM,I
- . S COMNUM="",I=0
- . F S COMNUM=$O(COM(COMNUM)) Q:COMNUM="" D
- . . S I=I+1
- . . S TCOM(I)=COM(COMNUM)
- . ;Add autoforward message to data stream
- . I AFOR S TCOM(I+1)="Consult forwarded by DST"
- . ;
- . K COM
- . M COM=TCOM
- . K TCOM
- ;Need to make sure the Autoforward Service exists
- I AFOR D
- . ;Check for APAY being populated if not change AFOR and log an error
- . I APAY="" D Q
- . . S AFOR=0
- . . S COM(I+1)="DVE-DST Error from VistA: No Autoforward Target"
- . ;Get Forwarding Service
- . S GMRCSS="" S GMRCSS=$O(^GMR(123.5,"B",APAY,GMRCSS))
- . Q:GMRCSS'=""
- . ;The forwarding service did not exist. Log error in msg, stop autoforward
- . S AFOR=0
- . S I="A" S I=$O(COM(I),-1)
- . S COM(I+1)="DVE-DST Error from VistA: Autoforward target not found"
- I $D(COM) D Q 1
- . I 'AFOR D CMT^GMRCGUIB(IEN123,.COM,"",DT,DUZ) Q
- . I AFOR D AFORT(IEN123,APAY,.COM,GMRCSS,GMRCORNP) Q
- I '$D(COM) S COM(1)="DVE-DST ID ISSUE: No Content sent from DST"
- D CMT^GMRCGUIB(IEN123,.COM,"",DT,DUZ) Q 1
- Q
- ;
- FINDIDO(ORIFN) ;
- ;1. Find IEN of consult record
- ;2. See if DST ID is in new field added by CPRS in GMRC*3.0*145 (file (#123), field (#85))
- ;3. If DST ID not found in 2. call $$FINDID45 to retrieve DST ID from the #100,#4.5 (RESPONSES multiple)
- ;4. If DST ID not found in 3. call $$FINDIDC to retrieve DST ID from #123,#20 (REASON FOR REQUEST)
- ;5. Call $$GETDST to retrieve Decision data from DST database and save it as a comment
- ;
- ;Input: ORIFN=IEN of file #100
- ;Output:
- ; 1=DST ID found, decision data retrieved, and comment created in the consult record
- ; -1^No Decision data found
- ;
- N ID,IEN123,X
- S IEN123=0,X=$G(^OR(100,ORIFN,4)) I $P(X,";",2)="GMRC" S IEN123=+X
- Q:'IEN123 "-1^No Decision data found"
- ;
- ;WCJ;GMRC*3.0*145;check if CPRS put it in the new field(#85) in the consult file(#123)
- N ERROR ; just for kicks - don't really need returned error.
- S ID=$TR($$GET1^DIQ(123,IEN123_",",85,,,"ERROR")," ","")
- ;
- I ID="" S ID=$$FINDID45(ORIFN) ;Next search for the DST ID in field #100,#4.5 (RESPONSES)
- ;Having not found the ID in the #100,#4.5 field, now look for it in the consult
- I ID="" S ID=$$FINDIDC(IEN123)
- ;remove space
- S ID=$TR(ID," ","")
- I ID="" Q "-1^No Decision data found"
- Q ID
- ;Q $$GETDST(IEN123,ID)
- ;
- FINDID45(ORIFN) ;
- ;This API searches through the #4.5 (RESPONSES) multiple in file #100 for the DST ID
- ;Input: ORIFN=IEN in file #100
- ;Output: DST ID or ""
- ;
- N I,ID,IENS,N,N1,N2,OUT,STR,X,Y
- S ID="",IENS=ORIFN_","
- K OUT D GETS^DIQ(100,IENS,"4.5*","","OUT")
- S N="" F S N=$O(OUT(100.045,N)) Q:N="" S (N1,STR)="" D
- . F S N1=$O(OUT(100.045,N,N1)) Q:N1="" S STR=STR_OUT(100.045,N,N1) D
- .. S N2="" F S N2=$O(OUT(100.045,N,N1,N2)) Q:N2="" S STR=STR_OUT(100.045,N,N1,N2)
- . I STR["DST ID:" D
- . . S STR=$P(STR,"DST ID:",2)
- . . S STR=$P(STR,"--",1) ;After refactoring str includes dashes at the end
- . . F I=1:1:$L(STR) S Y=$E(STR,I) Q:Y="#" S ID=ID_Y
- Q ID
- ;
- FINDIDC(IEN123) ;
- ;This API searches FILE #123, FIELD #20 (REASON FOR REQUEST)looking for a
- ;"DST ID:" tag and, if found, will extract the DST ID and call API
- ;$$GETDST to retrieve the decision data from the DST database and create
- ;a comment in the consult containing the decision data
- ;
- ;Input: IEN123 IEN of file #123
- ;Output: DST ID or ""
- ;
- N I,ID,IENS,N,OUT,X,Y
- S ID="",IENS=IEN123_","
- K OUT D GETS^DIQ(123,IENS,"20","","OUT")
- S N="" F S N=$O(OUT(123,IENS,20,N)) Q:N="" S X=OUT(123,IENS,20,N) D:X["DST ID:"
- .S X=$P(X,"DST ID:",2) F I=1:1:$L(X) S Y=$E(X,I) Q:Y="#" S ID=ID_Y
- Q ID
- ;
- ;
- ;Post Install to add DST web server/service
- EN ;
- N FDA ; -- FileMan Data Array
- N WEBVICE ; -- Web Service Internal Entry Number
- N WEBVER ; -- Web Server Internal Entry Number
- N MULTIEN ; -- Web Service Multiple Internal Entry Number
- N WSTAT ; -- Web Service Status
- N IENROOT,MSGROOT,IENROOT1,VICEIEN
- ;
- K FDA
- S WEBVICE=$O(^XOB(18.02,"B","DST GET ID SERVICE",0))
- S WEBVICE=$S(WEBVICE:WEBVICE,1:"+1")
- S FDA(18.02,WEBVICE_",",.01)="DST GET ID SERVICE" ; NAME
- S FDA(18.02,WEBVICE_",",.02)="REST" ; TYPE
- S FDA(18.02,WEBVICE_",",200)="vs/v1/consultFactor" ; CONTEXT ROOT
- D UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
- K IENROOT,MSGROOT,FDA
- ;
- S WEBVER=$O(^XOB(18.12,"B","DST GET ID SERVER",0))
- S WEBVER=$S(WEBVER:WEBVER,1:"+1")
- S FDA(18.12,WEBVER_",",.01)="DST GET ID SERVER" ; NAME
- S FDA(18.12,WEBVER_",",.03)="443" ; PORT
- S FDA(18.12,WEBVER_",",.04)="dst-dev.domain.ext" ; SERVER
- S FDA(18.12,WEBVER_",",.06)="ENABLED" ; STATUS 1-ENABLED / 0-DISABLED
- S FDA(18.12,WEBVER_",",.07)=60 ; DEFAULT HTTP TIMEOUT
- S FDA(18.12,WEBVER_",",1.01)="NO" ; LOGIN REQUIRED
- S FDA(18.12,WEBVER_",",3.01)="FALSE" ; SSL ENABLED
- ;Need to determine if we are creating a new file, or updating an existing one
- N NEW
- S NEW=1
- I $D(^XOB(18.12,WEBVER,0)) S NEW=0
- I NEW=1 D
- . D UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
- I NEW=0 D
- . D FILE^DIE("E","FDA","MSGROOT")
- ;
- ;
- S IENROOT1=$G(IENROOT(1)),MULTIEN=0
- ;
- S WEBVER=$S(IENROOT1:IENROOT1,1:WEBVER)
- K IENROOT,MSGROOT,FDA
- S VICEIEN=0 F S VICEIEN=$O(^XOB(18.12,WEBVER,100,"B",VICEIEN)) Q:'VICEIEN I $$GET1^DIQ(18.02,VICEIEN,.01)="DST GET ID SERVICE" S MULTIEN=VICEIEN Q
- S MULTIEN=$S(MULTIEN:MULTIEN,1:"+1")
- S FDA(18.121,MULTIEN_","_WEBVER_",",.01)="DST GET ID SERVICE" ; WEB SERVICE
- S FDA(18.121,MULTIEN_","_WEBVER_",",.06)="ENABLED" ; STATUS 1-ENABLED / 0-DISABLED
- D UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
- ;
- SPROT ;Set protocol GMRC SIGNED CONSULT DST as an item on GMRC EVSEND OR
- ;
- N GMRDGIEN,GMRERR,GMREXIT,GMRFDA,GMRIEN,GMRRTCL,J,PRTCLITM,V,X,Y
- ;
- D MES^XPDUTL($T(+0)_" post-init routine started "_$$HTE^XLFDT($H))
- S V=$$SVDATA D MES^XPDUTL("Old data saved in "_V)
- S GMRRTCL="GMRC SIGNED CONSULT DST",GMRIEN=$O(^ORD(101,"B",GMRRTCL,0))
- ; protocol missing, write message and exit
- I '(GMRIEN>0) D MES^XPDUTL(GMRRTCL_" protocol not found. It must be installed to proceed.") Q
- ;
- S Y="GMRC EVSEND OR",GMRDGIEN=$O(^ORD(101,"B",Y,0))
- ; protocol missing, write message and exit
- I '(GMRDGIEN>0) D MES^XPDUTL(Y_" protocol not found. No ITEM update performed.") Q
- ; make GMRC EVSEND OR an extended action
- S GMRFDA(101,GMRDGIEN_",",4)="X"
- D UPDATE^DIE("","GMRFDA","","GMRERR")
- I $D(GMRERR) D Q ; something went wrong
- .D MES^XPDUTL("FileMan error when editing GMRC EVSEND OR protocol")
- .N V S V="GMRERR" F S V=$Q(@V) Q:V="" D MES^XPDUTL(V_" = "_@V)
- ;
- ; is protocol already an item?
- S GMREXIT=$O(^ORD(101,GMRDGIEN,10,"B",GMRIEN,0))
- I GMREXIT D MES^XPDUTL(GMRRTCL_" already an ITEM in "_Y_". No update needed.") Q
- ;
- ; add protocol as ITEM
- K GMRFDA,GMRERR
- S GMRFDA(101.01,"+1,"_GMRDGIEN_",",.01)=GMRIEN
- D UPDATE^DIE("","GMRFDA","PRTCLITM","GMRERR")
- I $D(GMRERR) D Q ; something went wrong
- .D MES^XPDUTL("FileMan error when adding ITEM to GMRC EVSEND OR protocol")
- .N V S V="GMRERR" F S V=$Q(@V) Q:V="" D MES^XPDUTL(V_" = "_@V)
- ; new ITEM sub-file IEN will be in PRTCLITM(1)
- D MES^XPDUTL(GMRRTCL_" protocol update finished "_$$HTE^XLFDT($H))
- ;
- Q
- ;
- SVDATA() ; extrinsic variable, save original FileMan data, returns storage node
- ;
- D DT^DICRW
- N FMERRCNT,GMRXTMP,GMRIEN,LN,NTRY,TXT,V,X,Y
- ;S Y=$$NOW^XLFDT,GMRXTMP=$NA(^XTMP("GMR INSTALL LOG",Y)) ; XTMP storage location
- S Y=$$NOW^XLFDT,GMRXTMP=$NA(^XTMP("GMR INSTALL LOG "_Y)) ; XTMP storage location
- ; ^XTMP log data expires in 90 days
- S X=$G(@GMRXTMP@(0)) S:X="" @GMRXTMP@(0)=$$FMADD^XLFDT(DT,90)_U_Y_"^GMR installation "_$$FMTE^XLFDT(Y)
- ;
- S FMERRCNT=0 ; FileMan error counter
- ; save entries in FileMan items list
- F LN=1:1 S TXT=$P($T(FMITMS+LN),";;",2,99) Q:TXT="" D
- .N FLNO,FMARRY,FMERR ; file #, FileMan returned value and error message arrays
- .S FLNO=+$P(TXT,U),X=$P(TXT,U,2,99) ; file number and target entry
- .Q:'(FLNO>1)!(X="") ; file and entry required
- .S GMRIEN=$$FIND1^DIC(FLNO,"","",X,"","","FMERR") ; lookup value in X is external format
- .I $D(FMERR) D Q ; log error message and quit
- ..S V="FMERR",FMERRCNT=FMERRCNT+1 F S V=$Q(@V) Q:V="" S @GMRXTMP@("FM LOOKUP ERROR",FMERRCNT,V)=@V
- .;
- .S:'(GMRIEN>0) FMERRCNT=FMERRCNT+1,@GMRXTMP@("FM ENTRY NOT FOUND",FMERRCNT)=TXT ; entry
- .S:GMRIEN>0 @GMRXTMP@("ENTRY",FLNO,GMRIEN)="entry found"
- .K FMERR ; just in case
- .D GETS^DIQ(FLNO,GMRIEN_",","**","EN","FMARRY","FMERR") ; data including sub-files, ignore null values
- .I $D(FMERR) D ; log error message
- ..S V="FMERR",FMERRCNT=FMERRCNT+1 F S V=$Q(@V) Q:V="" S @GMRXTMP@("FM DATA ERROR",FMERRCNT,V)=@V
- .; save the data
- .M @GMRXTMP@("ENTRY")=FMARRY
- ;
- Q GMRXTMP ; return ^XTMP storage location
- ;
- FMITMS ; list of FileMan entries: "file # ^ .01 field value"
- ;;101^GMRC EVSEND OR
- ;
- Q
- AFORT(IEN123,APAY,COM,GMRCSS,GMRCORNP) ; Entry point for AutoForwarding of a consult
- ;requires the Name of the consult we are forwarding too
- ;IEN123 - IEN of consult from File 123
- ;GMRCSS - Service to which consult is being forwarded
- ;GMRCATTN - Provider whose attention consult is sent to. Can be "" or pointer to File 200
- ;GMRCURGI - Urgency of the request from the 123 file pointing to the 101 file
- ;GMRCORNP - Person who is responsible for forwarding the consult
- ;COM is the comments array explaining the forwarding action from DST
- ; passed in as COM(1)="Xxxx Xxxxx...",COM(2)="Xxxx Xx Xxx...", COM(3)="Xxxxx Xxx Xx...", etc.
- K GMRCATTN,ORDATE,GMRCURGI
- S GMRCATTN="",ORDATE=""
- S GMRCURGI=$P(^GMR(123,IEN123,0),"^",9)
- S Y=$$FR^GMRCGUIA(IEN123,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,.COM,ORDATE)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCDST 14664 printed Feb 18, 2025@23:11:53 Page 2
- GMRCDST ;ABV/BL - Retrieve Decision from DST server;May 21, 2020@07:06:12
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**124,139,152,145,177**;DEC 27, 1997;Build 4
- +2 ;
- +3 ;SAC EXEMPTION 20200131-01 : GMRC use of vendor specific code
- +4 ;IA6173
- +5 ;IA6171
- +6 ;
- PROT(MSG) ;GMRC SIGNED CONSULT DST-PROTOCOL ENTRY POINT
- +1 ;
- +2 ;Extract Order Number FROM THE ORC SEGMENT
- +3 NEW GMRCMSG,GMRCPKG,MSH,ORC,IEN123,SIGN,ORA,X,SIGNED,DUP
- +4 SET GMRCMSG=$SELECT($LENGTH($GET(MSG)):MSG,1:"MSG")
- if '$ORDER(@GMRCMSG@(0))
- QUIT
- +5 SET MSH=0
- FOR
- SET MSH=$ORDER(@GMRCMSG@(MSH))
- if MSH'>0
- QUIT
- if $EXTRACT(@GMRCMSG@(MSH),1,3)="MSH"
- QUIT
- +6 if 'MSH
- QUIT
- if '$LENGTH($GET(@GMRCMSG@(MSH)))
- QUIT
- +7 ;
- +8 SET ORC=MSH
- FOR
- SET ORC=$ORDER(@GMRCMSG@(+ORC))
- if ORC'>0
- QUIT
- IF $EXTRACT(@GMRCMSG@(ORC),1,3)="ORC"
- Begin DoDot:1
- +9 SET ORC=ORC_U_@GMRCMSG@(ORC)
- +10 SET ORIFN=+$PIECE($PIECE(ORC,"|",3),";")
- End DoDot:1
- +11 ;GET THE CONSULT IEN FROM THE ORDER
- +12 SET IEN123=0
- SET X=$GET(^OR(100,ORIFN,4))
- IF $PIECE(X,";",2)="GMRC"
- SET IEN123=+X
- +13 IF IEN123=""
- QUIT "-1^No Consult found"
- +14 ;QUIT IF ORDER IS NOT SIGNED
- +15 SET ORA=0
- SET SIGN=0
- SET SIGNED=0
- +16 FOR
- SET ORA=$ORDER(^OR(100,ORIFN,8,ORA))
- if +ORA'=ORA!(SIGNED)
- QUIT
- Begin DoDot:1
- +17 SET SIGN=$PIECE(^OR(100,ORIFN,8,ORA,0),"^",6)
- +18 IF SIGN>0
- SET SIGNED=1
- End DoDot:1
- +19 if SIGNED=0
- QUIT "-1^ORDER NOT SIGNED"
- +20 ;
- +21 ;Need the DUZ of user from Order file for Autoforward
- +22 KILL GMRCORNP
- +23 SET GMRCORNP=$$GET1^DIQ(100,ORIFN,3,"I")
- +24 SET ID=$$FINDIDO(ORIFN)
- +25 IF ID=""
- QUIT "-1^NO DST ID FOUND"
- +26 IF $PIECE(ID,"^")="-1"
- QUIT "-1^NO DST DATA FOUND"
- +27 ;Check if this DST Note has been added to the consult already
- +28 ;is there an existing comment on the consult, check for duplicate ID
- +29 SET DUP=0
- +30 IF $DATA(^GMR(123,IEN123,40,0))
- SET DUP=$$DUPID(IEN123,ID)
- +31 IF DUP
- QUIT "-1^DST NOTE ALREADY ADDED TO CONSULT"
- +32 ;
- +33 QUIT $$GETDST(IEN123,ID)
- +34 ;
- DUPID(IEN123,ID) ;Check to see if this ID has already been entered into the consult
- +1 ;
- +2 NEW CNODE,CINC,DUP,NOTEID,EDATA
- +3 SET DUP=0
- SET CNODE=0
- SET EDATA=0
- +4 IF IEN123=""
- QUIT DUP
- +5 FOR
- SET CNODE=$ORDER(^GMR(123,IEN123,40,CNODE))
- if +CNODE'=CNODE!(DUP)
- QUIT
- Begin DoDot:1
- +6 SET CINC=0
- +7 FOR
- SET CINC=$ORDER(^GMR(123,IEN123,40,CNODE,1,CINC))
- if CINC=""!(DUP)
- QUIT
- Begin DoDot:2
- +8 IF ^GMR(123,IEN123,40,CNODE,1,CINC,0)["CSC-Consult primary stop code:"
- SET EDATA=1
- +9 IF ^GMR(123,IEN123,40,CNODE,1,CINC,0)["DST ID:"
- Begin DoDot:3
- +10 SET NOTEID=""
- +11 SET NOTEID=$PIECE(^GMR(123,IEN123,40,CNODE,1,CINC,0),"DST ID:",2)
- +12 IF NOTEID[ID
- SET DUP=1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 ;Check if we have already loaded DST data
- +14 ;If DUP is positive but EDATA=0 no data is actually loaded, set DUP to 0
- +15 IF 'EDATA
- SET DUP=0
- +16 QUIT DUP
- +17 ;
- GETDST(IEN123,ID) ;
- +1 ;This API retrieves the decision data from the DST database using ID
- +2 ;Input:
- +3 ; IEN123 The IEN of file #123
- +4 ; ID The DST ID
- +5 ;Output:
- +6 ; If decision data not found: -1^No decision data found
- +7 ; If decision data found: 1
- +8 ;
- +9 ;Autoforwarding variables added
- +10 ; AFOR: Indicator of Autoforward value = DAF-DST Forwarding:
- +11 ; APAY: Name of consult service from file 123.5 to forward to
- +12 ;
- +13 NEW A,B,CAPTIONS,COM,COMCT,DATA,I,SERVER,SERVICE,RESOURCE,REQUEST,RESPONSE,RESULT,RET,X,ERRFLG
- +14 KILL NUMERR
- +15 SET ERRFLG=0
- SET NUMERR=0
- +16 SET SERVER="DST GET ID SERVER"
- +17 SET SERVICE="DST GET ID SERVICE"
- +18 IF ID=0
- QUIT "-1^NO VALID ID SUBMITTED"
- +19 SET RESOURCE="/"_ID
- +20 ; Get an instance of the REST request object.
- +21 SET REQUEST=$$GETREST^XOBWLIB(SERVICE,SERVER)
- +22 SET REQUEST.Timeout=60
- +23 SET REQUEST.OpenTimeout=30
- +24 ;
- TRYAG ; Execute the HTTP Get method.
- +1 KILL XUERR,RESPJSON,AFOR,APAY,GMRCSS
- +2 ; WCJ;GMRC*3.0*177
- KILL COM
- +3 ; WCJ;GMRC*3.0*177
- SET ERRFLG=0
- +4 ;Set variable to check for AutoForward
- SET AFOR=0
- SET APAY=""
- +5 SET RESULT=$$GET^XOBWLIB(REQUEST,RESOURCE,.XUERR,0)
- +6 IF 'RESULT
- Begin DoDot:1
- +7 ;NEED TO WRITE ERROR TO 123 FILE
- SET COM(1)="DVE-DST Error from VistA:"
- +8 SET COM(2)=XUERR.code
- +9 IF XUERR["Http"
- SET COM(3)=XUERR.statusLine
- +10 IF XUERR["ObjectError"
- SET COM(3)=XUERR.domain
- SET COM(4)=XUERR.errorType
- +11 SET ERRFLG=1
- SET NUMERR=NUMERR+1
- End DoDot:1
- +12 ;If the ERRFLG then store the error in the consult
- +13 IF ERRFLG&(NUMERR<10)
- HANG 2
- GOTO TRYAG
- +14 IF ERRFLG
- DO CMT^GMRCGUIB(IEN123,.COM,"",DT,DUZ)
- QUIT 0
- +15 ; Process the response.
- +16 SET RESPONSE=REQUEST.HttpResponse
- +17 SET DATA=RESPONSE.Data
- +18 ;code is not really in JSON format, not changing variable names
- +19 SET RESPJSON=""
- +20 FOR
- if DATA.AtEnd
- QUIT
- SET RESPJSON=RESPJSON_DATA.ReadLine()
- +21 SET RESPJSON=$TRANSLATE(RESPJSON,$CHAR(10),"")
- +22 ;current data is blob of text with ^ delimited fields. Put each field on its own line
- +23 FOR I=1:1:$LENGTH(RESPJSON,"^")
- Begin DoDot:1
- +24 SET COM(I)=$PIECE(RESPJSON,"^",I)
- +25 ;BL;152 need to quit before checking for Autoforward
- IF COM(I)=""
- KILL COM(I)
- QUIT
- +26 ;check for autoforwarding GMRC*3.0*139
- +27 IF COM(I)["DAF-DST Forwarding:"
- Begin DoDot:2
- +28 IF $PIECE(COM(I),":",2)["YES"
- SET AFOR=1
- End DoDot:2
- +29 IF COM(I)["AFD-DST Forward to"
- Begin DoDot:2
- +30 SET APAY=$PIECE(COM(I),":",2)
- +31 ;REMOVE LEADING SPACE FOR FORWARDED CONSULT
- IF $EXTRACT(APAY,1)=" "
- SET APAY=$EXTRACT(APAY,2,$LENGTH(APAY))
- End DoDot:2
- End DoDot:1
- +32 ;If we have data in the COM array store in the Note, other wise quit with an error
- +33 IF $DATA(COM)
- Begin DoDot:1
- +34 ;COM ARRAY IS EXPECTED TO BE SERIALLY NUMBERED
- +35 NEW TCOM,COMNUM,I
- +36 SET COMNUM=""
- SET I=0
- +37 FOR
- SET COMNUM=$ORDER(COM(COMNUM))
- if COMNUM=""
- QUIT
- Begin DoDot:2
- +38 SET I=I+1
- +39 SET TCOM(I)=COM(COMNUM)
- End DoDot:2
- +40 ;Add autoforward message to data stream
- +41 IF AFOR
- SET TCOM(I+1)="Consult forwarded by DST"
- +42 ;
- +43 KILL COM
- +44 MERGE COM=TCOM
- +45 KILL TCOM
- End DoDot:1
- +46 ;Need to make sure the Autoforward Service exists
- +47 IF AFOR
- Begin DoDot:1
- +48 ;Check for APAY being populated if not change AFOR and log an error
- +49 IF APAY=""
- Begin DoDot:2
- +50 SET AFOR=0
- +51 SET COM(I+1)="DVE-DST Error from VistA: No Autoforward Target"
- End DoDot:2
- QUIT
- +52 ;Get Forwarding Service
- +53 SET GMRCSS=""
- SET GMRCSS=$ORDER(^GMR(123.5,"B",APAY,GMRCSS))
- +54 if GMRCSS'=""
- QUIT
- +55 ;The forwarding service did not exist. Log error in msg, stop autoforward
- +56 SET AFOR=0
- +57 SET I="A"
- SET I=$ORDER(COM(I),-1)
- +58 SET COM(I+1)="DVE-DST Error from VistA: Autoforward target not found"
- End DoDot:1
- +59 IF $DATA(COM)
- Begin DoDot:1
- +60 IF 'AFOR
- DO CMT^GMRCGUIB(IEN123,.COM,"",DT,DUZ)
- QUIT
- +61 IF AFOR
- DO AFORT(IEN123,APAY,.COM,GMRCSS,GMRCORNP)
- QUIT
- End DoDot:1
- QUIT 1
- +62 IF '$DATA(COM)
- SET COM(1)="DVE-DST ID ISSUE: No Content sent from DST"
- +63 DO CMT^GMRCGUIB(IEN123,.COM,"",DT,DUZ)
- QUIT 1
- +64 QUIT
- +65 ;
- FINDIDO(ORIFN) ;
- +1 ;1. Find IEN of consult record
- +2 ;2. See if DST ID is in new field added by CPRS in GMRC*3.0*145 (file (#123), field (#85))
- +3 ;3. If DST ID not found in 2. call $$FINDID45 to retrieve DST ID from the #100,#4.5 (RESPONSES multiple)
- +4 ;4. If DST ID not found in 3. call $$FINDIDC to retrieve DST ID from #123,#20 (REASON FOR REQUEST)
- +5 ;5. Call $$GETDST to retrieve Decision data from DST database and save it as a comment
- +6 ;
- +7 ;Input: ORIFN=IEN of file #100
- +8 ;Output:
- +9 ; 1=DST ID found, decision data retrieved, and comment created in the consult record
- +10 ; -1^No Decision data found
- +11 ;
- +12 NEW ID,IEN123,X
- +13 SET IEN123=0
- SET X=$GET(^OR(100,ORIFN,4))
- IF $PIECE(X,";",2)="GMRC"
- SET IEN123=+X
- +14 if 'IEN123
- QUIT "-1^No Decision data found"
- +15 ;
- +16 ;WCJ;GMRC*3.0*145;check if CPRS put it in the new field(#85) in the consult file(#123)
- +17 ; just for kicks - don't really need returned error.
- NEW ERROR
- +18 SET ID=$TRANSLATE($$GET1^DIQ(123,IEN123_",",85,,,"ERROR")," ","")
- +19 ;
- +20 ;Next search for the DST ID in field #100,#4.5 (RESPONSES)
- IF ID=""
- SET ID=$$FINDID45(ORIFN)
- +21 ;Having not found the ID in the #100,#4.5 field, now look for it in the consult
- +22 IF ID=""
- SET ID=$$FINDIDC(IEN123)
- +23 ;remove space
- +24 SET ID=$TRANSLATE(ID," ","")
- +25 IF ID=""
- QUIT "-1^No Decision data found"
- +26 QUIT ID
- +27 ;Q $$GETDST(IEN123,ID)
- +28 ;
- FINDID45(ORIFN) ;
- +1 ;This API searches through the #4.5 (RESPONSES) multiple in file #100 for the DST ID
- +2 ;Input: ORIFN=IEN in file #100
- +3 ;Output: DST ID or ""
- +4 ;
- +5 NEW I,ID,IENS,N,N1,N2,OUT,STR,X,Y
- +6 SET ID=""
- SET IENS=ORIFN_","
- +7 KILL OUT
- DO GETS^DIQ(100,IENS,"4.5*","","OUT")
- +8 SET N=""
- FOR
- SET N=$ORDER(OUT(100.045,N))
- if N=""
- QUIT
- SET (N1,STR)=""
- Begin DoDot:1
- +9 FOR
- SET N1=$ORDER(OUT(100.045,N,N1))
- if N1=""
- QUIT
- SET STR=STR_OUT(100.045,N,N1)
- Begin DoDot:2
- +10 SET N2=""
- FOR
- SET N2=$ORDER(OUT(100.045,N,N1,N2))
- if N2=""
- QUIT
- SET STR=STR_OUT(100.045,N,N1,N2)
- End DoDot:2
- +11 IF STR["DST ID:"
- Begin DoDot:2
- +12 SET STR=$PIECE(STR,"DST ID:",2)
- +13 ;After refactoring str includes dashes at the end
- SET STR=$PIECE(STR,"--",1)
- +14 FOR I=1:1:$LENGTH(STR)
- SET Y=$EXTRACT(STR,I)
- if Y="#"
- QUIT
- SET ID=ID_Y
- End DoDot:2
- End DoDot:1
- +15 QUIT ID
- +16 ;
- FINDIDC(IEN123) ;
- +1 ;This API searches FILE #123, FIELD #20 (REASON FOR REQUEST)looking for a
- +2 ;"DST ID:" tag and, if found, will extract the DST ID and call API
- +3 ;$$GETDST to retrieve the decision data from the DST database and create
- +4 ;a comment in the consult containing the decision data
- +5 ;
- +6 ;Input: IEN123 IEN of file #123
- +7 ;Output: DST ID or ""
- +8 ;
- +9 NEW I,ID,IENS,N,OUT,X,Y
- +10 SET ID=""
- SET IENS=IEN123_","
- +11 KILL OUT
- DO GETS^DIQ(123,IENS,"20","","OUT")
- +12 SET N=""
- FOR
- SET N=$ORDER(OUT(123,IENS,20,N))
- if N=""
- QUIT
- SET X=OUT(123,IENS,20,N)
- if X["DST ID
- Begin DoDot:1
- +13 SET X=$PIECE(X,"DST ID:",2)
- FOR I=1:1:$LENGTH(X)
- SET Y=$EXTRACT(X,I)
- if Y="#"
- QUIT
- SET ID=ID_Y
- End DoDot:1
- +14 QUIT ID
- +15 ;
- +16 ;
- +17 ;Post Install to add DST web server/service
- EN ;
- +1 ; -- FileMan Data Array
- NEW FDA
- +2 ; -- Web Service Internal Entry Number
- NEW WEBVICE
- +3 ; -- Web Server Internal Entry Number
- NEW WEBVER
- +4 ; -- Web Service Multiple Internal Entry Number
- NEW MULTIEN
- +5 ; -- Web Service Status
- NEW WSTAT
- +6 NEW IENROOT,MSGROOT,IENROOT1,VICEIEN
- +7 ;
- +8 KILL FDA
- +9 SET WEBVICE=$ORDER(^XOB(18.02,"B","DST GET ID SERVICE",0))
- +10 SET WEBVICE=$SELECT(WEBVICE:WEBVICE,1:"+1")
- +11 ; NAME
- SET FDA(18.02,WEBVICE_",",.01)="DST GET ID SERVICE"
- +12 ; TYPE
- SET FDA(18.02,WEBVICE_",",.02)="REST"
- +13 ; CONTEXT ROOT
- SET FDA(18.02,WEBVICE_",",200)="vs/v1/consultFactor"
- +14 DO UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
- +15 KILL IENROOT,MSGROOT,FDA
- +16 ;
- +17 SET WEBVER=$ORDER(^XOB(18.12,"B","DST GET ID SERVER",0))
- +18 SET WEBVER=$SELECT(WEBVER:WEBVER,1:"+1")
- +19 ; NAME
- SET FDA(18.12,WEBVER_",",.01)="DST GET ID SERVER"
- +20 ; PORT
- SET FDA(18.12,WEBVER_",",.03)="443"
- +21 ; SERVER
- SET FDA(18.12,WEBVER_",",.04)="dst-dev.domain.ext"
- +22 ; STATUS 1-ENABLED / 0-DISABLED
- SET FDA(18.12,WEBVER_",",.06)="ENABLED"
- +23 ; DEFAULT HTTP TIMEOUT
- SET FDA(18.12,WEBVER_",",.07)=60
- +24 ; LOGIN REQUIRED
- SET FDA(18.12,WEBVER_",",1.01)="NO"
- +25 ; SSL ENABLED
- SET FDA(18.12,WEBVER_",",3.01)="FALSE"
- +26 ;Need to determine if we are creating a new file, or updating an existing one
- +27 NEW NEW
- +28 SET NEW=1
- +29 IF $DATA(^XOB(18.12,WEBVER,0))
- SET NEW=0
- +30 IF NEW=1
- Begin DoDot:1
- +31 DO UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
- End DoDot:1
- +32 IF NEW=0
- Begin DoDot:1
- +33 DO FILE^DIE("E","FDA","MSGROOT")
- End DoDot:1
- +34 ;
- +35 ;
- +36 SET IENROOT1=$GET(IENROOT(1))
- SET MULTIEN=0
- +37 ;
- +38 SET WEBVER=$SELECT(IENROOT1:IENROOT1,1:WEBVER)
- +39 KILL IENROOT,MSGROOT,FDA
- +40 SET VICEIEN=0
- FOR
- SET VICEIEN=$ORDER(^XOB(18.12,WEBVER,100,"B",VICEIEN))
- if 'VICEIEN
- QUIT
- IF $$GET1^DIQ(18.02,VICEIEN,.01)="DST GET ID SERVICE"
- SET MULTIEN=VICEIEN
- QUIT
- +41 SET MULTIEN=$SELECT(MULTIEN:MULTIEN,1:"+1")
- +42 ; WEB SERVICE
- SET FDA(18.121,MULTIEN_","_WEBVER_",",.01)="DST GET ID SERVICE"
- +43 ; STATUS 1-ENABLED / 0-DISABLED
- SET FDA(18.121,MULTIEN_","_WEBVER_",",.06)="ENABLED"
- +44 DO UPDATE^DIE("E","FDA","IENROOT","MSGROOT")
- +45 ;
- SPROT ;Set protocol GMRC SIGNED CONSULT DST as an item on GMRC EVSEND OR
- +1 ;
- +2 NEW GMRDGIEN,GMRERR,GMREXIT,GMRFDA,GMRIEN,GMRRTCL,J,PRTCLITM,V,X,Y
- +3 ;
- +4 DO MES^XPDUTL($TEXT(+0)_" post-init routine started "_$$HTE^XLFDT($HOROLOG))
- +5 SET V=$$SVDATA
- DO MES^XPDUTL("Old data saved in "_V)
- +6 SET GMRRTCL="GMRC SIGNED CONSULT DST"
- SET GMRIEN=$ORDER(^ORD(101,"B",GMRRTCL,0))
- +7 ; protocol missing, write message and exit
- +8 IF '(GMRIEN>0)
- DO MES^XPDUTL(GMRRTCL_" protocol not found. It must be installed to proceed.")
- QUIT
- +9 ;
- +10 SET Y="GMRC EVSEND OR"
- SET GMRDGIEN=$ORDER(^ORD(101,"B",Y,0))
- +11 ; protocol missing, write message and exit
- +12 IF '(GMRDGIEN>0)
- DO MES^XPDUTL(Y_" protocol not found. No ITEM update performed.")
- QUIT
- +13 ; make GMRC EVSEND OR an extended action
- +14 SET GMRFDA(101,GMRDGIEN_",",4)="X"
- +15 DO UPDATE^DIE("","GMRFDA","","GMRERR")
- +16 ; something went wrong
- IF $DATA(GMRERR)
- Begin DoDot:1
- +17 DO MES^XPDUTL("FileMan error when editing GMRC EVSEND OR protocol")
- +18 NEW V
- SET V="GMRERR"
- FOR
- SET V=$QUERY(@V)
- if V=""
- QUIT
- DO MES^XPDUTL(V_" = "_@V)
- End DoDot:1
- QUIT
- +19 ;
- +20 ; is protocol already an item?
- +21 SET GMREXIT=$ORDER(^ORD(101,GMRDGIEN,10,"B",GMRIEN,0))
- +22 IF GMREXIT
- DO MES^XPDUTL(GMRRTCL_" already an ITEM in "_Y_". No update needed.")
- QUIT
- +23 ;
- +24 ; add protocol as ITEM
- +25 KILL GMRFDA,GMRERR
- +26 SET GMRFDA(101.01,"+1,"_GMRDGIEN_",",.01)=GMRIEN
- +27 DO UPDATE^DIE("","GMRFDA","PRTCLITM","GMRERR")
- +28 ; something went wrong
- IF $DATA(GMRERR)
- Begin DoDot:1
- +29 DO MES^XPDUTL("FileMan error when adding ITEM to GMRC EVSEND OR protocol")
- +30 NEW V
- SET V="GMRERR"
- FOR
- SET V=$QUERY(@V)
- if V=""
- QUIT
- DO MES^XPDUTL(V_" = "_@V)
- End DoDot:1
- QUIT
- +31 ; new ITEM sub-file IEN will be in PRTCLITM(1)
- +32 DO MES^XPDUTL(GMRRTCL_" protocol update finished "_$$HTE^XLFDT($HOROLOG))
- +33 ;
- +34 QUIT
- +35 ;
- SVDATA() ; extrinsic variable, save original FileMan data, returns storage node
- +1 ;
- +2 DO DT^DICRW
- +3 NEW FMERRCNT,GMRXTMP,GMRIEN,LN,NTRY,TXT,V,X,Y
- +4 ;S Y=$$NOW^XLFDT,GMRXTMP=$NA(^XTMP("GMR INSTALL LOG",Y)) ; XTMP storage location
- +5 ; XTMP storage location
- SET Y=$$NOW^XLFDT
- SET GMRXTMP=$NAME(^XTMP("GMR INSTALL LOG "_Y))
- +6 ; ^XTMP log data expires in 90 days
- +7 SET X=$GET(@GMRXTMP@(0))
- if X=""
- SET @GMRXTMP@(0)=$$FMADD^XLFDT(DT,90)_U_Y_"^GMR installation "_$$FMTE^XLFDT(Y)
- +8 ;
- +9 ; FileMan error counter
- SET FMERRCNT=0
- +10 ; save entries in FileMan items list
- +11 FOR LN=1:1
- SET TXT=$PIECE($TEXT(FMITMS+LN),";;",2,99)
- if TXT=""
- QUIT
- Begin DoDot:1
- +12 ; file #, FileMan returned value and error message arrays
- NEW FLNO,FMARRY,FMERR
- +13 ; file number and target entry
- SET FLNO=+$PIECE(TXT,U)
- SET X=$PIECE(TXT,U,2,99)
- +14 ; file and entry required
- if '(FLNO>1)!(X="")
- QUIT
- +15 ; lookup value in X is external format
- SET GMRIEN=$$FIND1^DIC(FLNO,"","",X,"","","FMERR")
- +16 ; log error message and quit
- IF $DATA(FMERR)
- Begin DoDot:2
- +17 SET V="FMERR"
- SET FMERRCNT=FMERRCNT+1
- FOR
- SET V=$QUERY(@V)
- if V=""
- QUIT
- SET @GMRXTMP@("FM LOOKUP ERROR",FMERRCNT,V)=@V
- End DoDot:2
- QUIT
- +18 ;
- +19 ; entry
- if '(GMRIEN>0)
- SET FMERRCNT=FMERRCNT+1
- SET @GMRXTMP@("FM ENTRY NOT FOUND",FMERRCNT)=TXT
- +20 if GMRIEN>0
- SET @GMRXTMP@("ENTRY",FLNO,GMRIEN)="entry found"
- +21 ; just in case
- KILL FMERR
- +22 ; data including sub-files, ignore null values
- DO GETS^DIQ(FLNO,GMRIEN_",","**","EN","FMARRY","FMERR")
- +23 ; log error message
- IF $DATA(FMERR)
- Begin DoDot:2
- +24 SET V="FMERR"
- SET FMERRCNT=FMERRCNT+1
- FOR
- SET V=$QUERY(@V)
- if V=""
- QUIT
- SET @GMRXTMP@("FM DATA ERROR",FMERRCNT,V)=@V
- End DoDot:2
- +25 ; save the data
- +26 MERGE @GMRXTMP@("ENTRY")=FMARRY
- End DoDot:1
- +27 ;
- +28 ; return ^XTMP storage location
- QUIT GMRXTMP
- +29 ;
- FMITMS ; list of FileMan entries: "file # ^ .01 field value"
- +1 ;;101^GMRC EVSEND OR
- +2 ;
- +3 QUIT
- AFORT(IEN123,APAY,COM,GMRCSS,GMRCORNP) ; Entry point for AutoForwarding of a consult
- +1 ;requires the Name of the consult we are forwarding too
- +2 ;IEN123 - IEN of consult from File 123
- +3 ;GMRCSS - Service to which consult is being forwarded
- +4 ;GMRCATTN - Provider whose attention consult is sent to. Can be "" or pointer to File 200
- +5 ;GMRCURGI - Urgency of the request from the 123 file pointing to the 101 file
- +6 ;GMRCORNP - Person who is responsible for forwarding the consult
- +7 ;COM is the comments array explaining the forwarding action from DST
- +8 ; passed in as COM(1)="Xxxx Xxxxx...",COM(2)="Xxxx Xx Xxx...", COM(3)="Xxxxx Xxx Xx...", etc.
- +9 KILL GMRCATTN,ORDATE,GMRCURGI
- +10 SET GMRCATTN=""
- SET ORDATE=""
- +11 SET GMRCURGI=$PIECE(^GMR(123,IEN123,0),"^",9)
- +12 SET Y=$$FR^GMRCGUIA(IEN123,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,.COM,ORDATE)
- +13 QUIT