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

IBDECLN1.m

Go to the documentation of this file. 
  1. IBDECLN1 ;ALB/AAS - Clean up Data Qualifiers and Package interfaces ; 23-JUN-97
  1.  ;;3.0;AUTOMATED INFO COLLECTION SYS;**14**;APR 24, 1997
  1.  ;
  1. PROBLEM(PROBLEM) ; -- Find out if Problem is in PCE DIM NODE in 357.6
  1.  ;
  1.  ;   pce dim node should not equal problem
  1.  N I,J
  1.  S I=0,PROBLEM=0
  1.  F  S I=$O(^IBE(357.6,I)) Q:'I  D
  1.  . I $P($G(^IBE(357.6,I,12)),"^",1)="PROBLEM" D
  1.  .. S PROBLEM=PROBLEM+1
  1.  .. S PROBLEM(0,I)=""
  1.  .. S PROBLEM(PROBLEM)=$P($G(^IBE(357.6,I,0)),"^",1)_" uses PROBLEM as the PCE DIM NODE"
  1.  . S J=0
  1.  . F  S J=$O(^IBE(357.6,I,13,J)) Q:'J  D
  1.  .. I $P($G(^IBE(357.6,I,13,J,0)),"^",4)="PROBLEM" D
  1.  ... S PROBLEM=PROBLEM+1
  1.  ... S PROBLEM(0,I)=""
  1.  ... S PROBLEM(PROBLEM)=$P($G(^IBE(357.6,I,0)),"^",1)_" uses PROBLEM as the PCE DIM NODE in the Allow. Qual. Multiple."
  1.  ;
  1.  Q
  1.  ;
  1. CLNSEL(TALK) ; -- Clean up selection list entries
  1.  ; -- should be run after running clnqlf, will update the zzbad pointers
  1.  ;
  1.  N I,J,K,L,X,Y,CNT,CNT1,CNT2,NAME,QLF,QLFNAM,PI,PINAM,PINPUT,REALQLF,REALNAM,PROBLEM,SELNAM,BLKNAM,IBQUIT,DIC,DIE,DIK,DA,DR,FRM,FRMNAM,FRMTYPE
  1.  S (CNT,CNT1,CNT2)=0
  1.  ;
  1.  D:TALK MES^XPDUTL("  ")
  1.  D:TALK MES^XPDUTL(">>> Now checking the SELECTION LIST file for inappropriate Data Qualifiers.")
  1.  ;
  1.  ; -- Find out if Problem is in PCE DIM NODE in 357.6
  1.  D PROBLEM(.PROBLEM)
  1.  ;
  1.  ; -- go through selection list file look at data qualifiers in
  1.  ;    subcolumn multiple fields
  1.  S I=0
  1.  F  S I=$O(^IBE(357.2,I)) Q:'I  D
  1.  . S CNT=CNT+1
  1.  . S SELNAM=$P($G(^IBE(357.2,I,0)),"^",1)
  1.  . S BLKNAM=$P($G(^IBE(357.1,+$P($G(^IBE(357.2,I,0)),"^",2),0)),"^",1)
  1.  . S FRM=+$P($G(^IBE(357.1,+$P($G(^IBE(357.2,I,0)),"^",2),0)),"^",2)
  1.  . S FRMNAM=$P($G(^IBE(357,+FRM,0)),"^",1)
  1.  . S FRMTYPE=$P($G(^IBE(357,+FRM,0)),"^",13)
  1.  . S PI=+$P($G(^IBE(357.2,I,0)),"^",11)
  1.  . S PINPUT=+$P($G(^IBE(357.6,PI,0)),"^",13)
  1.  . S PINAM=$P($G(^IBE(357.6,+$P($G(^IBE(357.2,I,0)),"^",11),0)),"^",1)
  1.  . ;
  1.  . S J=0
  1.  . F  S J=$O(^IBE(357.2,I,2,J)) Q:'J  D
  1.  .. S QLF=+$P($G(^IBE(357.2,I,2,J,0)),"^",9)
  1.  .. Q:'QLF
  1.  .. S QLFNAM=$P($G(^IBD(357.98,QLF,0)),"^",1)
  1.  .. ;
  1.  .. Q:$E(QLFNAM,1,6)'="ZZBAD-"
  1.  .. S CNT1=CNT1+1
  1.  .. S REALNAM=$P(QLFNAM,"ZZBAD-",2)
  1.  .. Q:REALNAM=""
  1.  .. S REALQLF=+$O(^IBD(357.98,"B",REALNAM,0))
  1.  .. Q:'REALQLF
  1.  ..;
  1.  ..; -- don't change if uses Problem node
  1.  .. I PROBLEM>0 I $D(PROBLEM(0,PI))!($D(PROBLEM(0,PINPUT))) D  Q
  1.  ... D MES^XPDUTL("  ")
  1.  ... D MES^XPDUTL(" >> The selection list "_SELNAM_" not updated, PCE DIM node set to PROBLEM")
  1.  ..
  1.  ..; -- now update the selection list to the real qualifier
  1.  .. S CNT2=CNT2+1
  1.  .. S $P(^IBE(357.2,I,2,J,0),"^",9)=REALQLF
  1.  ..;
  1.  ..D:TALK MESSAGE
  1.  ;
  1.  ; -- write out summary
  1.  K X
  1.  S X(1)=" ",X(2)=" >> Summary of Selection List Check:"
  1.  D:TALK MES^XPDUTL(.X)
  1.  K X
  1.  S X(1)=" "
  1.  S X(2)=" >> A total of "_CNT_" selection list"_$S(CNT=1:" was",1:"s were")_" checked."
  1.  I CNT1=0 S X(3)="    No problems were found."
  1.  I CNT1>0 S X(3)="    A total of "_CNT1_" problem"_$S(CNT1=1:" was",1:"s were")_" found and "_CNT2_" were corrected."
  1.  D:TALK MES^XPDUTL(.X)
  1.  Q
  1.  ;
  1. MESSAGE ; -- write out what happened
  1.  N K,X,CLIN,CLNLST
  1.  S CLNLST=""
  1.  S CLIN="^TMP(""CLST"",$J)"
  1.  D CLINICS^IBDFU4(FRM,CLIN)
  1.  S X(1)="  "
  1.  S X(2)=">>> Qualifier problem in Encounter form "_FRMNAM
  1.  I FRMTYPE S X(2)=X(2)_" Number "_FRMTYPE
  1.  I @CLIN@(0)=0 S X(3)="    This form was not used by clinics"
  1.  I @CLIN@(0)>0 D
  1.  . S X(3)="    This form is used in the following clinics:"
  1.  . S K=0,J=3 F  S K=$O(@CLIN@(K)) Q:K=""  S CLNLST=CLNLST_", "_K D
  1.  . . Q:$L(CLNLST)>55
  1.  . . S J=J+1,X(J)="        "_CLNLST
  1.  . . S CLNLST=""
  1.  S X(J+1)="       In the "_BLKNAM_" Block"
  1.  S X(J+2)="       In the "_SELNAM_" Selection List"
  1.  S X(J+3)="       the qualifier of "_QLFNAM_" Changed to "_REALNAM
  1.  D:TALK MES^XPDUTL(.X)
  1.  Q