Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCCX

GMRCCX.m

Go to the documentation of this file. 
  1. 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
  1.  ;Consult Closure Tool
  1.  ;
  1.  ; IA#   Usage      Component
  1.  ; --------------------------
  1.  ; 1058  Private    MDEL^DDSUTL
  1.  ; 1058  Private    MLOAD^DDSUTL
  1.  ; 2051  Supported  LIST^DIC
  1.  ; 2052  Supported  $$GET1^DID
  1.  ; 2053  Supported  UPDATE^DIE
  1.  ; 2054  Supported  CLEAN^DILF
  1.  ;
  1. LOOKUP(GMX,GM0,GMFILE) ;
  1.  ; *** Process additions/deletions [-]XXX*
  1.  ; Called from the pre-lookup transform nodes
  1.  ; ^DD(123.0331 -> 123.0336,.01,7.5)
  1.  N GMFDA,GMIEN,GMLST,D0,D1,DA,DIC,DIERR
  1.  N DIHELP,DIMSG,DUOUT,DIRUT,DIROUT,DO,DTOUT,X,Y
  1.  I ($G(GMX)?1.E1"*"),($G(GM0)>0) D
  1.  . S GMLST=$NA(^TMP("DILIST",$J))
  1.  . S GMFDA=$NA(^TMP("GMCTR-FDA",$J))
  1.  . S GMIEN=$NA(^TMP("GMCTR-IEN",$J))
  1.  . K @GMLST,@GMFDA,@GMIEN
  1.  . I $E(GMX)="-" D
  1.  .. D DEL(.GMX,GM0,GMFILE)
  1.  .. Q
  1.  . E  D
  1.  .. D ADD(.GMX,GM0,GMFILE)
  1.  .. Q
  1.  . K @GMLST,@GMFDA,@GMIEN
  1.  . Q
  1.  Q
  1.  ;
  1. ADD(GMX,GM0,GMFILE) ;
  1.  ; *** Process additions XXX* (Copy/Mod of LOOKE^XPDET)
  1.  N GMDATA,GMIENS,GMINDX,GMPOIN,GMSCRN
  1.  S GMPOIN=$$GET1^DID(GMFILE,.01,"","SPECIFIER")
  1.  S GMPOIN=$TR(GMPOIN,$TR(GMPOIN,"0123456789."))
  1.  S GMSCRN=$$DICS(GMFILE)
  1.  S GMX=$P(GMX,"*",1)
  1.  D LIST^DIC(GMPOIN,"","","","*","",GMX,"",GMSCRN)
  1.  I $G(@GMLST@(0))>0 D
  1.  . S GMINDX=0
  1.  . F  S GMINDX=$O(@GMLST@(2,GMINDX)) Q:GMINDX'>0  D
  1.  .. S GMDATA=$G(@GMLST@(2,GMINDX))
  1.  .. I GMDATA>0 D
  1.  ... S GMIENS="?+"_GMINDX_","_GM0_","
  1.  ... S @GMFDA@(GMFILE,GMIENS,.01)=GMDATA
  1.  ... S @GMIEN@(GMINDX)=GMDATA
  1.  ... Q
  1.  .. Q
  1.  . I $D(@GMFDA) D
  1.  .. D UPDATE^DIE("",GMFDA,GMIEN)
  1.  .. I '$D(DIERR),$D(DDS),$D(@GMIEN) D MLOAD^DDSUTL(GMIEN)
  1.  .. D CLEAN^DILF
  1.  .. Q
  1.  . S GMX=""
  1.  . Q
  1.  E  D
  1.  . K GMX
  1.  . Q
  1.  Q
  1.  ;
  1. DEL(GMX,GM0,GMFILE) ;
  1.  ; *** Process deletions -XXX* (Copy/Mod of DEL^XPDET)
  1.  N GM1,GMIENS,GMINDX
  1.  S GMX=$P(GMX,"*",1),GMX=$E(GMX,2,$L(GMX)-1)
  1.  D LIST^DIC(GMFILE,","_GM0_",","","","*","",GMX)
  1.  I $G(@GMLST@(0))>0 D
  1.  . S GMINDX=0
  1.  . F  S GMINDX=$O(@GMLST@(2,GMINDX)) Q:GMINDX'>0  D
  1.  .. S GM1=$G(@GMLST@(2,GMINDX))
  1.  .. I GM1>0 D
  1.  ... S GMIENS=GM1_","_GM0_","
  1.  ... S @GMFDA@(GMFILE,GMIENS,.01)="@"
  1.  ... Q
  1.  .. Q
  1.  . I $D(@GMFDA) D
  1.  .. D UPDATE^DIE("",GMFDA)
  1.  .. I '$D(DIERR),$D(DDS) D MDEL^DDSUTL($NA(@GMLST@(2)))
  1.  .. D CLEAN^DILF
  1.  .. Q
  1.  . S GMX=""
  1.  . Q
  1.  E  D
  1.  . K GMX
  1.  . Q
  1.  Q
  1.  ;
  1. DICS(GMFILE) ;
  1.  ; *** DIC("S") data screens
  1.  ; Called from ADD^GMRCCX and
  1.  ; ^DD(123.0331 -> 123.0336,.01,0 & 12.1)
  1.  N GMSCRN
  1.  ; Disabled consult services are not selectable
  1.  S GMSCRN(123.0331)="I $P(^(0),U,2)'=9"
  1.  ; Inactive consult procedures are not selectable
  1.  S GMSCRN(123.0332)="I $P(^(0),U,2)'>0"
  1.  ; Only consult order items are selectable
  1.  S GMSCRN(123.0333)="I ($P(^(0),U,3)="""")&(^(0)?1""GMRC""1(1""R"",1""T"").E)"
  1.  ; Only active clinical procedures are selectable
  1.  S GMSCRN(123.0334)="I $P(^(0),U,9)=1"
  1.  ; Only clinics are selectable
  1.  S GMSCRN(123.0335)="I $P(^(0),U,3)=""C"""
  1.  ; Only titles are selectable
  1.  S GMSCRN(123.0336)="I $P(^(0),U,4)=""DOC"""
  1.  Q $G(GMSCRN(+$G(GMFILE)),"I 1")
  1.  ;