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

SCMSVUT2.m

Go to the documentation of this file. 
  1. SCMSVUT2 ;ALB/JLU;Utility routine for AMBCARE;06/28/99
  1.  ;;5.3;Scheduling;**66,180,254,293,325,466,521,1015**;AUG 13,1993;Build 21
  1.  ;06/28/99 ACS Added CPT modifier validation
  1.  ;
  1. COUNT(VALER) ;counts the number of errored encounters found.
  1.  ;INPUT VALER - The array containing the errors.
  1.  ;OUTPUT the number of errors
  1.  ;
  1.  N VAR,CNT
  1.  S VAR="",CNT=0
  1.  F  S VAR=$O(@VALER@(VAR)) Q:VAR']""  S CNT=CNT+1
  1.  Q CNT
  1.  ;
  1. IPERR(VALER) ;counts the number of inpatient errored encounters found.
  1.  ;INPUT VALER - The array containing the errors.
  1.  ;OUTPUT the number of errors
  1.  ;
  1.  N VAR,CNT
  1.  S VAR="",CNT=0
  1.  F  S VAR=$O(@VALER@(VAR)) Q:VAR']""  D
  1.  .I $$INPATENC^SCDXUTL(VAR) S CNT=CNT+1
  1.  Q CNT
  1.  ;
  1. FILEVERR(PTR,VALERR) ;files the errors found for an encounter
  1.  ;INPUT  PTR - The pointer to the entry in the transmission file 409.73
  1.  ;      VALERR - The array holding the errors for the encounter.
  1.  ;OUTPUT  0 - did not file
  1.  ;        1 - did file
  1.  N SEG,FILE
  1.  I '$D(VALERR) Q 0
  1.  S SEG="",FILE=-1
  1.  F  S SEG=$O(@VALERR@(SEG)) Q:SEG']""  D FILE(VALERR,SEG,PTR,.FILE)
  1.  Q $S(FILE=1:1,1:0)
  1.  ;
  1. FILE(VALERR,SEG,PTR,FILE) ;
  1.  N NBR
  1.  S NBR=0
  1.  F  S NBR=$O(@VALERR@(SEG,NBR)) Q:'NBR  DO
  1.  .N CODPTR,CODE
  1.  .S CODE=$G(@VALERR@(SEG,NBR))
  1.  .I CODE']"" Q
  1.  .S CODPTR=$O(^SD(409.76,"B",CODE,""))
  1.  .I 'CODPTR Q
  1.  .I $D(^SD(409.75,"AER",PTR,CODPTR)) S FILE=1 Q
  1.  .S FILE=$$CRTERR^SCDXFU02(PTR,CODE)
  1.  .Q
  1.  Q
  1.  ;
  1. VALWL(CLIN) ;WORKLOAD VALIDATION AT CHECK OUT
  1.  ;INPUT CLIN - IEN OF CLINIC
  1.  ;OUTPUT 0 - DO NOT VALIDATE WORKLOAD
  1.  ;       1 - VALIDATE CLINIC WORKLOAD
  1.  N A1
  1.  I '$D(CLIN) S CLIN=0
  1.  S A1=$P($G(^SC(+CLIN,0)),U,30)
  1.  Q $S(A1=1:1,1:0)
  1.  ;
  1. VALIDATE(XMITPTR) ;validates data that has a entry in the transmit file.
  1.  ;
  1.  ;INPUT    XMITPTR - This is the point to an entry in file 409.73.
  1.  ;
  1.  ;OUTPUT    -1 - the was a problem with the inputs
  1.  ;           0 - no errors were found
  1.  ;           1 - errors were found
  1.  ;
  1.  N VALERR,ERR,HL,HLEID,DFN
  1.  S ANS=-1
  1.  S XMITPTR=+$G(XMITPTR)
  1.  I $G(^SD(409.73,XMITPTR,0))']"" G VALQ
  1.  D PATDFN^SCDXUTL2(XMITPTR)
  1.  ;
  1.  S HL7XMIT="^TMP(""HLS"","_$J_")",VALERR="^TMP(""SCDXVALID"","_$J_","_XMITPTR_")"
  1.  ;Initialze HL7 variables
  1.  S HLEID=+$O(^ORD(101,"B","SCDX AMBCARE SEND SERVER FOR ADT-Z00",0))
  1.  I ('HLEID) G VALQ
  1.  D INIT^HLFNC2(HLEID,.HL)
  1.  I ($O(HL(""))="") G VALQ
  1.  ;
  1.  S ERR=$$BUILDHL7^SCDXMSG0(XMITPTR,.HL,1,HL7XMIT,1,VALERR)
  1.  ;
  1.  I ERR<0,$O(@VALERR@(0))']"" D VALIDATE^SCMSVUT0("INTERNAL","","V900",VALERR,0)
  1.  S ANS=0
  1.  D DELAERR^SCDXFU02(XMITPTR,0)
  1.  D DEMUPDT(DFN,VALERR,"DEMO")
  1.  I $O(@VALERR@(0))]"" DO
  1.  .N FILE
  1.  .S ANS=1
  1.  .S FILE=$$FILEVERR(XMITPTR,VALERR)
  1.  .Q
  1.  ;
  1.  K @VALERR,@HL7XMIT
  1.  ;
  1. VALQ Q ANS
  1.  ;
  1. DEMUPDT(DFN,VALERR,TYP) ;
  1.  ;This entry point updates all the other encoutners for this patient
  1.  ;that HAVE errors with a new set or demographic errors or deletes all
  1.  ;the demographic errors if none were found.
  1.  ;INPUT DFN - The patient's DFN
  1.  ;   VALERR - errors to log
  1.  ;      TYP - The type of errors to delete and log.
  1.  ;            Right now demographic errors are the only kind "DEMO"
  1.  ;
  1.  S DFN=$G(DFN),TYP=$G(TYP),VALERR=$G(VALERR)
  1.  I DFN=""!(TYP="")!(VALERR="") Q
  1.  N PTRS,RNG,LP,PTR
  1.  S RNG=$P($T(@(TYP)),";;",2),PTRS=""
  1.  D CLEAN(DFN,RNG,.PTRS)
  1.  I '$D(@VALERR@("PID")) Q
  1.  I PTRS']"" Q
  1.  F LP=1:1 S PTR=$P(PTRS,U,LP) Q:PTR']""  DO
  1.  .I '$D(^SD(409.73,PTR,0)) Q
  1.  .N FILE
  1.  .D FILE(VALERR,"PID",PTR,.FILE)
  1.  .Q
  1.  Q
  1.  ;
  1. CLEAN(DFN,RNG,PTRS) ;This subroutine cleans out all errors for a pateint
  1.  ;and returns a string of which entries in 409.73 were cleaned of errors
  1.  ;
  1.  N LP,COD,LP2,IEN
  1.  F LP=1:1 S COD=$P(RNG,U,LP) Q:COD']""  I $D(^SD(409.75,"ACOD",DFN,COD)) S IEN="" F LP2=1:1 S IEN=$O(^SD(409.75,"ACOD",DFN,COD,IEN)) Q:IEN']""  DO
  1.  .N VAR,RES
  1.  .S VAR=$P($G(^SD(409.75,IEN,0)),U,1)_"^"
  1.  .I $P(VAR,U,1)="" S PTR="" Q
  1.  .S RES=$$DELERR^SCDXFU02(IEN)
  1.  .I PTRS[VAR Q
  1.  .S PTRS=PTRS_VAR
  1.  .Q
  1.  Q
  1.  ;
  1. MODCODE(DATA,ENCDT) ;
  1.  ;
  1.  ;---------------------------------------------------------------
  1.  ;    VALIDATE MODIFIER AND CPT+MODIFIER COMBINATION
  1.  ;
  1.  ; INPUT: DATA - The procedure and modifier code to be checked 
  1.  ;               format: CPT~modifier
  1.  ;       ENCDT - The date of the encounter
  1.  ;
  1.  ;OUTPUT:    1 - valid modifier and CPT+modifier combination
  1.  ;           0 - invalid modifier or CPT+modifier combination
  1.  ;
  1.  ;**NOTE**   This call makes the assumption that leading zeros are
  1.  ;           intact in the input.
  1.  ;---------------------------------------------------------------
  1.  ;
  1.  ;- validate modifier only
  1.  N DATAMOD
  1.  S DATAMOD=$P(DATA,"~",2)
  1.  I '$D(DATAMOD) Q 0
  1.  I $$MOD^ICPTMOD(DATAMOD,"E",ENCDT,1)'>0 Q 0
  1.  ;
  1.  ;- validate CPT+modifier pair
  1.  N DATAPROC
  1.  S DATAPROC=$P(DATA,"~",1)
  1.  I '$D(DATAPROC) Q 0
  1.  I $$MODP^ICPTMOD(DATAPROC,DATAMOD,"E",ENCDT,1)'>0 Q 0
  1.  Q 1
  1.  ;
  1. MODMETH(DATA) ;
  1.  ;
  1.  ;---------------------------------------------------------------
  1.  ;    VALIDATE MODIFIER CODING METHOD
  1.  ;
  1.  ; INPUT: DATA - The modifier coding method to be checked 
  1.  ;
  1.  ;OUTPUT:    1 - valid modifier coding method
  1.  ;           0 - invalid modifier coding method
  1.  ;
  1.  ; Valid modifier coding methods: C and H
  1.  ;---------------------------------------------------------------
  1.  ;
  1.  I '$D(DATA) Q 0
  1.  S DATA=","_DATA_","
  1.  I ",C,H,"'[DATA Q 0
  1.  Q 1
  1.  ;
  1. ETHNIC(DATA)    ;
  1.  ;INPUT  DATA - the ethnicity code to be validated (NNNN-C-XXX)
  1.  ;
  1.  N VAL,MTHD
  1.  I '$D(DATA) Q 0
  1.  I DATA="" Q 1
  1.  S VAL=$P(DATA,"-",1,2)
  1.  S MTHD=$P(DATA,"-",3)
  1.  I VAL'?4N1"-"1N Q 0
  1.  I ",SLF,UNK,PRX,OBS,"'[MTHD Q 0
  1.  Q 1
  1. CONFDT(DATA,SUB)    ;CONFIDENTIAL ADDRESS START/STOP DATE
  1.  N X,Y,%DT,DTOUT,STDT,ENDT
  1.  I '$D(DATA) Q 0
  1.  S STDT=$P(DATA,SUB,1)
  1.  S ENDT=$P(DATA,SUB,2)
  1.  I STDT="" Q 0
  1.  S STDT=$$FMDATE^HLFNC(STDT)
  1.  S X=STDT,%DT="X" D ^%DT I Y=-1 Q 0  ;SD/521 added %DT
  1.  I ENDT="" Q 1
  1.  S ENDT=$$FMDATE^HLFNC(ENDT)
  1.  S X=ENDT,%DT="X" D ^%DT I Y=-1 Q 0  ;SD/521 added %DT
  1.  I $$FMDIFF^XLFDT(ENDT,STDT,1)<0 Q 0
  1.  Q 1
  1.  ;
  1. CONFCAT(DATA)             ;CONFIDENTIAL ADDRESS CATEGORY TYPE
  1.  I '$D(DATA) Q 0
  1.  I DATA="" Q 0
  1.  N VAL,GOOD
  1.  S GOOD=0
  1.  F VAL="VACAA","VACAC","VACAE","VACAM","VACAO" I DATA=VAL S GOOD=1 Q
  1.  Q GOOD
  1.  ;
  1. CVEDT(DATA) ;Combat vet end date (ZEL.38)
  1.  ;Input  : DATA - CombatVetIndicator ^ CombatVetEndDate
  1.  ;Output : 1 = Good / 0 = Bad
  1.  ;
  1.  N CVI,CVEDT
  1.  S DATA=$G(DATA)
  1.  S CVI=$P(DATA,"^",1)
  1.  S CVEDT=$P(DATA,"^",2)
  1.  I 'CVI Q $S(CVEDT="":1,1:0)
  1.  Q CVEDT?8N
  1.  ;
  1. CLCV(DATA,SDOE) ;Cross check for combat vet classification question
  1.  ;Input  : DATA - Answer to classification question
  1.  ;         SDOE - Pointer to encounter (file # 409.68)
  1.  ;Output : 1 = Good / 0 = Bad
  1.  ;
  1.  S DATA=$G(DATA)
  1.  Q:(DATA'=1) 1
  1.  N VET,SDDT,SDOE0
  1.  S SDOE=$G(SDOE) Q:'SDOE 0
  1.  S SDOE0=$G(^SCE(SDOE,0))
  1.  S SDDT=+SDOE0 Q:'SDDT 0
  1.  S DFN=+$P(SDOE0,"^",2) Q:'DFN 0
  1.  S VET=$P($$EL^SDCO22(DFN,SDOE),"^",5)
  1.  I VET'="Y" Q 0
  1.  S VET=+$$CVEDT^DGCV(DFN,SDDT)
  1.  Q $S(VET=1:1,1:0)
  1.  ;
  1. DEMO ;;2000^2030^2050^2100^2150^2200^2210^2220^2230^2240^2250^2300^2330^2360