GMRCCX ;SFVAMC/DAD - Consult Closure Tool: Config File Utilities ;01/20/17 15:19
;;3.0;CONSULT/REQUEST TRACKING;**89**;DEC 27, 1997;Build 62
;Consult Closure Tool
;
; IA# Usage Component
; --------------------------
; 1058 Private MDEL^DDSUTL
; 1058 Private MLOAD^DDSUTL
; 2051 Supported LIST^DIC
; 2052 Supported $$GET1^DID
; 2053 Supported UPDATE^DIE
; 2054 Supported CLEAN^DILF
;
LOOKUP(GMX,GM0,GMFILE) ;
; *** Process additions/deletions [-]XXX*
; Called from the pre-lookup transform nodes
; ^DD(123.0331 -> 123.0336,.01,7.5)
N GMFDA,GMIEN,GMLST,D0,D1,DA,DIC,DIERR
N DIHELP,DIMSG,DUOUT,DIRUT,DIROUT,DO,DTOUT,X,Y
I ($G(GMX)?1.E1"*"),($G(GM0)>0) D
. S GMLST=$NA(^TMP("DILIST",$J))
. S GMFDA=$NA(^TMP("GMCTR-FDA",$J))
. S GMIEN=$NA(^TMP("GMCTR-IEN",$J))
. K @GMLST,@GMFDA,@GMIEN
. I $E(GMX)="-" D
.. D DEL(.GMX,GM0,GMFILE)
.. Q
. E D
.. D ADD(.GMX,GM0,GMFILE)
.. Q
. K @GMLST,@GMFDA,@GMIEN
. Q
Q
;
ADD(GMX,GM0,GMFILE) ;
; *** Process additions XXX* (Copy/Mod of LOOKE^XPDET)
N GMDATA,GMIENS,GMINDX,GMPOIN,GMSCRN
S GMPOIN=$$GET1^DID(GMFILE,.01,"","SPECIFIER")
S GMPOIN=$TR(GMPOIN,$TR(GMPOIN,"0123456789."))
S GMSCRN=$$DICS(GMFILE)
S GMX=$P(GMX,"*",1)
D LIST^DIC(GMPOIN,"","","","*","",GMX,"",GMSCRN)
I $G(@GMLST@(0))>0 D
. S GMINDX=0
. F S GMINDX=$O(@GMLST@(2,GMINDX)) Q:GMINDX'>0 D
.. S GMDATA=$G(@GMLST@(2,GMINDX))
.. I GMDATA>0 D
... S GMIENS="?+"_GMINDX_","_GM0_","
... S @GMFDA@(GMFILE,GMIENS,.01)=GMDATA
... S @GMIEN@(GMINDX)=GMDATA
... Q
.. Q
. I $D(@GMFDA) D
.. D UPDATE^DIE("",GMFDA,GMIEN)
.. I '$D(DIERR),$D(DDS),$D(@GMIEN) D MLOAD^DDSUTL(GMIEN)
.. D CLEAN^DILF
.. Q
. S GMX=""
. Q
E D
. K GMX
. Q
Q
;
DEL(GMX,GM0,GMFILE) ;
; *** Process deletions -XXX* (Copy/Mod of DEL^XPDET)
N GM1,GMIENS,GMINDX
S GMX=$P(GMX,"*",1),GMX=$E(GMX,2,$L(GMX)-1)
D LIST^DIC(GMFILE,","_GM0_",","","","*","",GMX)
I $G(@GMLST@(0))>0 D
. S GMINDX=0
. F S GMINDX=$O(@GMLST@(2,GMINDX)) Q:GMINDX'>0 D
.. S GM1=$G(@GMLST@(2,GMINDX))
.. I GM1>0 D
... S GMIENS=GM1_","_GM0_","
... S @GMFDA@(GMFILE,GMIENS,.01)="@"
... Q
.. Q
. I $D(@GMFDA) D
.. D UPDATE^DIE("",GMFDA)
.. I '$D(DIERR),$D(DDS) D MDEL^DDSUTL($NA(@GMLST@(2)))
.. D CLEAN^DILF
.. Q
. S GMX=""
. Q
E D
. K GMX
. Q
Q
;
DICS(GMFILE) ;
; *** DIC("S") data screens
; Called from ADD^GMRCCX and
; ^DD(123.0331 -> 123.0336,.01,0 & 12.1)
N GMSCRN
; Disabled consult services are not selectable
S GMSCRN(123.0331)="I $P(^(0),U,2)'=9"
; Inactive consult procedures are not selectable
S GMSCRN(123.0332)="I $P(^(0),U,2)'>0"
; Only consult order items are selectable
S GMSCRN(123.0333)="I ($P(^(0),U,3)="""")&(^(0)?1""GMRC""1(1""R"",1""T"").E)"
; Only active clinical procedures are selectable
S GMSCRN(123.0334)="I $P(^(0),U,9)=1"
; Only clinics are selectable
S GMSCRN(123.0335)="I $P(^(0),U,3)=""C"""
; Only titles are selectable
S GMSCRN(123.0336)="I $P(^(0),U,4)=""DOC"""
Q $G(GMSCRN(+$G(GMFILE)),"I 1")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCCX 3084 printed Apr 09, 2024@20:52:17 Page 2
GMRCCX ;SFVAMC/DAD - Consult Closure Tool: Config File Utilities ;01/20/17 15:19
+1 ;;3.0;CONSULT/REQUEST TRACKING;**89**;DEC 27, 1997;Build 62
+2 ;Consult Closure Tool
+3 ;
+4 ; IA# Usage Component
+5 ; --------------------------
+6 ; 1058 Private MDEL^DDSUTL
+7 ; 1058 Private MLOAD^DDSUTL
+8 ; 2051 Supported LIST^DIC
+9 ; 2052 Supported $$GET1^DID
+10 ; 2053 Supported UPDATE^DIE
+11 ; 2054 Supported CLEAN^DILF
+12 ;
LOOKUP(GMX,GM0,GMFILE) ;
+1 ; *** Process additions/deletions [-]XXX*
+2 ; Called from the pre-lookup transform nodes
+3 ; ^DD(123.0331 -> 123.0336,.01,7.5)
+4 NEW GMFDA,GMIEN,GMLST,D0,D1,DA,DIC,DIERR
+5 NEW DIHELP,DIMSG,DUOUT,DIRUT,DIROUT,DO,DTOUT,X,Y
+6 IF ($GET(GMX)?1.E1"*")
IF ($GET(GM0)>0)
Begin DoDot:1
+7 SET GMLST=$NAME(^TMP("DILIST",$JOB))
+8 SET GMFDA=$NAME(^TMP("GMCTR-FDA",$JOB))
+9 SET GMIEN=$NAME(^TMP("GMCTR-IEN",$JOB))
+10 KILL @GMLST,@GMFDA,@GMIEN
+11 IF $EXTRACT(GMX)="-"
Begin DoDot:2
+12 DO DEL(.GMX,GM0,GMFILE)
+13 QUIT
End DoDot:2
+14 IF '$TEST
Begin DoDot:2
+15 DO ADD(.GMX,GM0,GMFILE)
+16 QUIT
End DoDot:2
+17 KILL @GMLST,@GMFDA,@GMIEN
+18 QUIT
End DoDot:1
+19 QUIT
+20 ;
ADD(GMX,GM0,GMFILE) ;
+1 ; *** Process additions XXX* (Copy/Mod of LOOKE^XPDET)
+2 NEW GMDATA,GMIENS,GMINDX,GMPOIN,GMSCRN
+3 SET GMPOIN=$$GET1^DID(GMFILE,.01,"","SPECIFIER")
+4 SET GMPOIN=$TRANSLATE(GMPOIN,$TRANSLATE(GMPOIN,"0123456789."))
+5 SET GMSCRN=$$DICS(GMFILE)
+6 SET GMX=$PIECE(GMX,"*",1)
+7 DO LIST^DIC(GMPOIN,"","","","*","",GMX,"",GMSCRN)
+8 IF $GET(@GMLST@(0))>0
Begin DoDot:1
+9 SET GMINDX=0
+10 FOR
SET GMINDX=$ORDER(@GMLST@(2,GMINDX))
if GMINDX'>0
QUIT
Begin DoDot:2
+11 SET GMDATA=$GET(@GMLST@(2,GMINDX))
+12 IF GMDATA>0
Begin DoDot:3
+13 SET GMIENS="?+"_GMINDX_","_GM0_","
+14 SET @GMFDA@(GMFILE,GMIENS,.01)=GMDATA
+15 SET @GMIEN@(GMINDX)=GMDATA
+16 QUIT
End DoDot:3
+17 QUIT
End DoDot:2
+18 IF $DATA(@GMFDA)
Begin DoDot:2
+19 DO UPDATE^DIE("",GMFDA,GMIEN)
+20 IF '$DATA(DIERR)
IF $DATA(DDS)
IF $DATA(@GMIEN)
DO MLOAD^DDSUTL(GMIEN)
+21 DO CLEAN^DILF
+22 QUIT
End DoDot:2
+23 SET GMX=""
+24 QUIT
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 KILL GMX
+27 QUIT
End DoDot:1
+28 QUIT
+29 ;
DEL(GMX,GM0,GMFILE) ;
+1 ; *** Process deletions -XXX* (Copy/Mod of DEL^XPDET)
+2 NEW GM1,GMIENS,GMINDX
+3 SET GMX=$PIECE(GMX,"*",1)
SET GMX=$EXTRACT(GMX,2,$LENGTH(GMX)-1)
+4 DO LIST^DIC(GMFILE,","_GM0_",","","","*","",GMX)
+5 IF $GET(@GMLST@(0))>0
Begin DoDot:1
+6 SET GMINDX=0
+7 FOR
SET GMINDX=$ORDER(@GMLST@(2,GMINDX))
if GMINDX'>0
QUIT
Begin DoDot:2
+8 SET GM1=$GET(@GMLST@(2,GMINDX))
+9 IF GM1>0
Begin DoDot:3
+10 SET GMIENS=GM1_","_GM0_","
+11 SET @GMFDA@(GMFILE,GMIENS,.01)="@"
+12 QUIT
End DoDot:3
+13 QUIT
End DoDot:2
+14 IF $DATA(@GMFDA)
Begin DoDot:2
+15 DO UPDATE^DIE("",GMFDA)
+16 IF '$DATA(DIERR)
IF $DATA(DDS)
DO MDEL^DDSUTL($NAME(@GMLST@(2)))
+17 DO CLEAN^DILF
+18 QUIT
End DoDot:2
+19 SET GMX=""
+20 QUIT
End DoDot:1
+21 IF '$TEST
Begin DoDot:1
+22 KILL GMX
+23 QUIT
End DoDot:1
+24 QUIT
+25 ;
DICS(GMFILE) ;
+1 ; *** DIC("S") data screens
+2 ; Called from ADD^GMRCCX and
+3 ; ^DD(123.0331 -> 123.0336,.01,0 & 12.1)
+4 NEW GMSCRN
+5 ; Disabled consult services are not selectable
+6 SET GMSCRN(123.0331)="I $P(^(0),U,2)'=9"
+7 ; Inactive consult procedures are not selectable
+8 SET GMSCRN(123.0332)="I $P(^(0),U,2)'>0"
+9 ; Only consult order items are selectable
+10 SET GMSCRN(123.0333)="I ($P(^(0),U,3)="""")&(^(0)?1""GMRC""1(1""R"",1""T"").E)"
+11 ; Only active clinical procedures are selectable
+12 SET GMSCRN(123.0334)="I $P(^(0),U,9)=1"
+13 ; Only clinics are selectable
+14 SET GMSCRN(123.0335)="I $P(^(0),U,3)=""C"""
+15 ; Only titles are selectable
+16 SET GMSCRN(123.0336)="I $P(^(0),U,4)=""DOC"""
+17 QUIT $GET(GMSCRN(+$GET(GMFILE)),"I 1")
+18 ;
