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

ACDRR1C.m

Go to the documentation of this file. 
  1. ACDRR1C ;IHS/ADC/EDE/KML - PROCESS CDMIS VISITS;
  1.  ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
  1.  ;
  1.  ; This routine processes each visit within date range, determines
  1.  ; if patient has problem of alcohol or drugs, and counts substances
  1.  ; being used.  A count is also kept for each problem encountered.
  1.  ;
  1. START ;
  1.  D INIT
  1.  D VISITS
  1.  D PATIENTS
  1.  D EOJ
  1.  Q
  1.  ;
  1. INIT ;
  1.  S (ACDBT,ACDBTH)=$H,ACDJOB=$J
  1.  K ^TMP("ACDRR1",$J)
  1.  Q
  1.  ;
  1. VISITS ; PROCESS ALL VISITS WITHIN DATE RANGE
  1.  S ACDVCNT=0
  1.  S ACDVDATE=$O(^ACDVIS("B",ACDDTLO),-1)
  1.  F  S ACDVDATE=$O(^ACDVIS("B",ACDVDATE)) Q:ACDVDATE=""!(ACDVDATE>ACDDTHI)  D
  1.  . S ACDVIEN=0
  1.  . F  S ACDVIEN=$O(^ACDVIS("B",ACDVDATE,ACDVIEN)) Q:'ACDVIEN  D VISIT
  1.  . Q
  1.  Q
  1.  ;
  1. VISIT ; PROCESS ONE VISIT
  1.  Q:'$D(^ACDVIS(ACDVIEN,0))  ;           bad xref
  1.  Q:$G(^ACDVIS(ACDVIEN,"BWP"))'=ACDPGM  ;not from current program
  1.  S X=^ACDVIS(ACDVIEN,0)
  1.  S ACDTC=$P(X,U,4) ;                    type contact
  1.  I ACDTC="IR"!(ACDTC="OT") Q
  1.  S ACDPIEN=$P(X,U,5) ;                  patient ien
  1.  Q:'ACDPIEN  ;                          bad data
  1.  I '$D(^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN)) S ^(ACDPIEN)=""
  1.  I ACDTC="CS" S ^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"CS",ACDVIEN)="" Q
  1.  I ACDTC="TD" D
  1.  .  NEW ACDCODE,ACDTYPE,ACDDATE
  1.  .  S ACDDATE=$P(X,U),ACDCODE=$P(X,U,2),ACDTYPE=$P(X,U,7)
  1.  .  S ^TMP("ACDRR1",$J,1,"LOS",ACDPIEN,ACDCODE_"/"_ACDTYPE,ACDDATE)=ACDVIEN
  1.  .  Q
  1.  D @("PRC"_ACDTC) ;                     process iif/td
  1.  S ACDVCNT=ACDVCNT+1
  1.  S (X,Y)=""
  1.  I $D(^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"A",ACDVIEN)) S X="A"
  1.  F  S Y=$O(ACDSTBL(Y)) Q:Y=""  S ^TMP("ACDRR1",$J,1,"DRUG",Y,ACDPIEN)="",X=$S(X="":Y,1:X_","_Y)
  1.  I X'="",X["," S ^TMP("ACDRR1",$J,1,"DRUG COMBO",X,ACDPIEN)=""
  1.  Q
  1.  ;
  1. PRCIN ; INITIAL
  1.  D PRCIIF
  1.  Q
  1.  ;
  1. PRCRE ; REOPEN
  1.  D PRCIIF
  1.  Q
  1.  ;
  1. PRCFU ; FOLLOWUP
  1.  D PRCIIF
  1.  Q
  1.  ;
  1. PRCIIF ; EP-PROCESS IIF ENTRY
  1.  K ACDSTBL
  1.  S ACDIIEN=$O(^ACDIIF("C",ACDVIEN,0))
  1.  Q:'ACDIIEN  ;                          no iif entry
  1.  S ^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN)=1 ; patients has iif or td
  1.  D PRCIIF2 ;                            check problems
  1.  D PRCIIF3 ;                            check drugs
  1.  Q
  1.  ;
  1. PRCIIF2 ; CHECK FOR PROBLEM OF ALCOHOL OR DRUGS & SAVE ALL PROBLEMS
  1.  ; do not stop when both found because need visits
  1.  Q:'$D(^ACDIIF(ACDIIEN,0))  ;           bad xref
  1.  S X=^ACDIIF(ACDIIEN,0)
  1.  S ACDTOB=$P(X,U,30) ;                  save tobacco use
  1.  D:ACDTOB PRCSETT
  1.  S ACDADAYS=$P(X,U,4) ;                 save days used alcohol
  1.  S ACDDDAYS=$P(X,U,5) ;                 save days used drugs
  1.  S X=+X
  1.  S ^TMP("ACDRR1",$J,1,"PROBLEM",X,ACDPIEN)=""
  1.  S ^TMP("ACDRR1",$J,1,"PRI PROB",X,ACDPIEN)=""
  1.  I X=ACDAIEN D PRCSETA
  1.  I X=ACDDIEN D PRCSETD
  1.  S Y=0
  1.  F  S Y=$O(^ACDIIF(ACDIIEN,3,Y)) Q:'Y  I $D(^ACDIIF(ACDIIEN,3,Y,0)) S X=+^(0) D
  1.  .  S ^TMP("ACDRR1",$J,1,"PROBLEM",X,ACDPIEN)=""
  1.  .  I X=ACDAIEN D PRCSETA
  1.  .  I X=ACDDIEN D PRCSETD
  1.  .  Q
  1.  Q
  1.  ;
  1. PRCIIF3 ; CHECK FOR DRUGS
  1.  Q:'$D(^ACDIIF(ACDIIEN,0))  ;           bad xref
  1.  S Y=0
  1.  F  S Y=$O(^ACDIIF(ACDIIEN,2,Y)) Q:'Y  I $D(^ACDIIF(ACDIIEN,2,Y,0)) S X=+^(0) S ACDSTBL(X)=""
  1.  Q
  1.  ;
  1. PRCTD ; EP-TRANS/DISC/CLOSE ENTRY
  1.  K ACDSTBL
  1.  S ACDTIEN=$O(^ACDTDC("C",ACDVIEN,0))
  1.  Q:'ACDTIEN  ;                          no tdc entry
  1.  S ^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN)=1 ; patients has iif or td
  1.  D PRCTD2 ;                             check alcohol
  1.  D PRCTD3 ;                             check drugs
  1.  Q
  1.  ;
  1. PRCTD2 ; CHECK FOR PROBLEM OF ALCOHOL OR DRUGS & SAVE ALL PROBLEMS
  1.  ; do not stop when both found because need visits
  1.  Q:'$D(^ACDTDC(ACDTIEN,0))  ;           bad xref
  1.  S X=^ACDTDC(ACDTIEN,0)
  1.  S ACDTOB=$P(X,U,30) ;                  save tobacco use
  1.  D:ACDTOB PRCSETT
  1.  S ACDADAYS=$P(X,U) ;                   save days used alcohol
  1.  S ACDDDAYS=$P(X,U,2) ;                 save days used drugs
  1.  S X=$P(X,U,27)
  1.  Q:'X  ;                                bad data
  1.  S ^TMP("ACDRR1",$J,1,"PROBLEM",X,ACDPIEN)=""
  1.  S ^TMP("ACDRR1",$J,1,"PRI PROB",X,ACDPIEN)=""
  1.  I X=ACDAIEN S ^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"A")="",^("A",ACDVIEN)=""
  1.  I X=ACDDIEN S ^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"D")="",^("D",ACDVIEN)=""
  1.  S Y=0
  1.  F  S Y=$O(^ACDTDC(ACDTIEN,3,Y)) Q:'Y  I $D(^ACDTDC(ACDTIEN,3,Y,0)) S X=+^(0) D
  1.  .  S ^TMP("ACDRR1",$J,1,"PROBLEM",X,ACDPIEN)=""
  1.  .  I X=ACDAIEN S ^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"A")="",^("A",ACDVIEN)=""
  1.  .  I X=ACDDIEN S ^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"D")="",^("D",ACDVIEN)=""
  1.  .  Q
  1.  Q
  1.  ;
  1. PRCTD3 ; CHECK FOR DRUGS
  1.  Q:'$D(^ACDTDC(ACDTIEN,0))  ;           bad xref
  1.  S Y=0
  1.  F  S Y=$O(^ACDTDC(ACDTIEN,2,Y)) Q:'Y  I $D(^ACDTDC(ACDTIEN,2,Y,0)) S X=+^(0) S ACDSTBL(X)=""
  1.  Q
  1.  ;
  1. PRCSETA ; SET ALCOHOL HIT
  1.  S ^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"A")="",^("A",ACDVIEN)="",^(ACDVIEN,"DAYS")=ACDADAYS
  1.  Q
  1.  ;
  1. PRCSETD ; SET DRUG HIT
  1.  S ^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"D")="",^("D",ACDVIEN)="",^(ACDVIEN,"DAYS")=ACDDDAYS
  1.  Q
  1.  ;
  1. PRCSETT ; SET TOBACCO HIT
  1.  S ^TMP("ACDRR1",$J,1,"PATIENT",ACDPIEN,"T",ACDTOB)=""
  1.  Q
  1.  ;
  1. PATIENTS ; PROCESS PATIENTS WITH VISITS WITHIN TIME FRAME
  1.  D PATIENTS^ACDRR1CB
  1.  Q
  1.  ;
  1. EOJ ;
  1.  S ACDET=$H
  1.  K C,X,Y,Z
  1.  K ACDA,ACDADAYS,ACDAGE,ACDAIEN,ACDCMBO,ACDCSC,ACDCSH,ACDCSHC,ACDCSIEN,ACDCT,ACDD,ACDDDAYS,ACDDIEN,ACDDRUG,ACDIIEN,ACDPIEN,ACDPRIEN,ACDSEX,ACDSTBL,ACDTC,ACDTOB,ACDTIEN,ACDVCNT,ACDVDATE,ACDVIEN
  1.  K ^TMP("ACDRR1",$J,1)
  1.  Q