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

IBDF18A.m

Go to the documentation of this file.
  1. IBDF18A ;ALB/CJM/AAS - ENCOUNTER FORM - utilities for PCE ;04/12/94
  1. ;;3.0;AUTOMATED INFO COLLECTION SYS;**34,38,51,63,69**;APR 24, 1997;Build 2
  1. ;
  1. ;
  1. GLL(CLINIC,INTRFACE,ARY,FILTER,PAR5,PAR6,ENCDATE) ; -- get lots of lists in one call
  1. ; -- input see GETLST but pass interface by reference expects
  1. ; INTRFACE(n) = name of select list in package interface file
  1. ;
  1. ; -- PAR5 => not currently used
  1. ; -- PAR6 => not currently used
  1. ;
  1. ; -- output see GETLST
  1. N X,COUNT
  1. S COUNT=0
  1. S X="" F S X=$O(INTRFACE(X)) Q:X="" D GETLST(CLINIC,INTRFACE(X),ARY,$G(FILTER),.COUNT,$G(PAR6),ENCDATE)
  1. Q
  1. ;
  1. GETLST(CLINIC,INTRFACE,ARY,FILTER,COUNT,MODIFIER,ENCDATE) ; -- returns any specified selection list for a clinic
  1. ; -- input CLINIC = pointer to hospital location file for clinic
  1. ; INTRFACE = name of selection list in package interface file
  1. ; ARY = name of array to return list in
  1. ; FILTER = predefined filters (optional, default = 1)
  1. ; 1 = must be selection list
  1. ; 2 = only visit cpts on list
  1. ; ENCDATE = encounter date
  1. ; MODIFIER = if modifiers are to be passed, 1=yes send modifiers
  1. ;
  1. ; -- output The format of the returned array is as follows
  1. ; @ARY@(0) = count of array element (0 of nothing found)
  1. ; @ARY@(1) = ^group header
  1. ; @ARY@(2) = P1 := cpt or icd code / ien of other items
  1. ; P2 := user defined text
  1. ; p3 := quantity (number of occurrences)
  1. ; p6 := user defined expanded text to send to PCE
  1. ; p7 := second code or item defined for line item
  1. ; p8 := third code or item defined for line item
  1. ; p9 := associated clinical lexicon term
  1. ;
  1. ; @ARY@(2,"MODIFIER",0)=count of CPT Modifiers for entry
  1. ; @ARY@(2,"MODIFIER",1)=2 character CPT Modifier value
  1. ; @ARY@(2,"MODIFIER",2)=2 character CPT Modifier value
  1. ; @ARY@(2,"MODIFIER",k+1)=2 character CPT Modifier value
  1. ;
  1. ; @ARY@(k) = ^next group header
  1. ; @ARY@(k+1) = problem ien or cpt or icd code^user define text
  1. ;
  1. ; -- output modification for patch 34:
  1. ; Narrative to Send to PCE (instead of printed text)
  1. ; field (2.01) in file 357.3, added as piece 6 of @ary@(n)
  1. ;
  1. ; if additional codes for an item (diagnosis) are added to
  1. ; item, they are added as pieces 7 and/or 8 of @ary@(n).
  1. ;
  1. ; if a type of visit code is requested and none found, will
  1. ; automatically look first for blocks named type of visit and
  1. ; second for filtered codes using regular cpt blocks.
  1. ;
  1. ; if a diagnosis block it requested and none found will
  1. ; automatically look for Clinic Common Problem List and
  1. ; then convert it to look like a diagnosis list
  1. ;
  1. N I,J,X,Y,INUM,IBQUIT,FORM,SETUP,LIST,BLOCK,OLDARY,IBDTMP,ROW,COL,BLK
  1. N LIST1,PACKAGE,IBDIMPDA,IBDCSYS
  1. K ^TMP("IBDUP",$J)
  1. S (IBQUIT,LIST)=0
  1. S PACKAGE=$E(INTRFACE,1,30)
  1. ;
  1. ;Setup array containing NAME of the Package Interface file
  1. ;This is the second parameter passed by PCE, TIU, & CPRS
  1. S LIST1("DG SELECT CPT PROCEDURE CODES")=""
  1. S LIST1("DG SELECT ICD-9 DIAGNOSIS CODE")=""
  1. S LIST1("DG SELECT ICD DIAGNOSIS CODES")=""
  1. S LIST1("DG SELECT ICD-10 DIAGNOSIS COD")=""
  1. S LIST1("DG SELECT VISIT TYPE CPT PROCE")=""
  1. S LIST1("GMP INPUT CLINIC COMMON PROBLE")=""
  1. S LIST1("GMP PATIENT ACTIVE PROBLEMS")=""
  1. ;
  1. S COUNT=$G(COUNT,0)
  1. I $G(FILTER)<1 S FILTER=1 ;default value=1
  1. I FILTER>1 S OLDARY=ARY,ARY="IBDTMP"
  1. S @ARY@(0)=+$G(@ARY@(0))
  1. I $G(CLINIC)="" G GETLSTQ
  1. I $G(^SC(CLINIC,0))="" G GETLSTQ
  1. I $G(INTRFACE)="" G GETLSTQ
  1. I INTRFACE["SELECT ICD",$D(LIST1(PACKAGE)) D
  1. . S IBDIMPDA=$$IMPDATE^IBDUTICD("10D"),IBDCSYS=1 I ENCDATE'<IBDIMPDA S IBDCSYS=30
  1. . I IBDCSYS=1 S INUM=$O(^IBE(357.6,"B","DG SELECT ICD-9 DIAGNOSIS CODE",0))
  1. . I IBDCSYS=30 S INUM=$O(^IBE(357.6,"B","DG SELECT ICD-10 DIAGNOSIS COD",0))
  1. E S INUM=$O(^IBE(357.6,"B",$E(INTRFACE,1,30),0))
  1. ;
  1. ; -- find forms defined for clinic
  1. ; piece 2 = basic form
  1. ; piece 3,4,6 = supplemental forms
  1. S SETUP=$G(^SD(409.95,+$O(^SD(409.95,"B",CLINIC,0)),0))
  1. G:SETUP="" GETLSTQ
  1. F I=2,3,4,6,8,9 S FORM=$P(SETUP,"^",I) D Q:IBQUIT
  1. .;
  1. .; -- find blocks on forms
  1. .Q:'FORM
  1. . D GETBLKS Q:'$O(BLK(0))
  1. . S (ROW,COL)=""
  1. . F S ROW=$O(BLK(ROW)) Q:ROW="" S COL="" F S COL=$O(BLK(ROW,COL)) Q:COL="" S BLOCK=$G(BLK(+ROW,+COL)) D
  1. ..;
  1. ..; -- see if package interface defined for blocks
  1. ..S LIST=0
  1. ..F S LIST=$O(^IBE(357.2,"C",BLOCK,LIST)) Q:'LIST I $P($G(^IBE(357.2,LIST,0)),"^",11)=INUM D COPYLIST^IBDF18A1(LIST,ARY,.COUNT)
  1. ;I COUNT D URH^IBDF18A1
  1. S @ARY@(0)=COUNT
  1. I FILTER=2 D F2^IBDF18A1(OLDARY)
  1. ;
  1. I COUNT=0 D
  1. .I $E(INTRFACE,1,30)=$E("DG SELECT VISIT TYPE CPT PROCEDURES",1,30) D TOV
  1. ;
  1. ; -- always check for both diagnosis and clinic common problems when
  1. ; looking for diagnosis, return in diagnosis format
  1. I $E(INTRFACE,1,30)=$E("DG SELECT ICD-9 DIAGNOSIS CODES",1,30) D CCP(COUNT)
  1. ;This routine checks list that have CPT & ICD codes for CSV.
  1. D CHKLST^IBDF18A2:$D(LIST1(PACKAGE))
  1. ;
  1. K ^TMP("IBDUP",$J)
  1. ;
  1. GETLSTQ Q
  1. ;
  1. GETBLKS ; -- get the blocks for a form in row,column order
  1. K BLK
  1. N ROW,COL
  1. S BLK=0
  1. F S BLK=$O(^IBE(357.1,"C",FORM,BLK)) Q:'BLK D
  1. . S ROW=$P($G(^IBE(357.1,+BLK,0)),"^",4),COL=$P(^IBE(357.1,+BLK,0),"^",5)
  1. . Q:ROW=""!(COL="")
  1. . S BLK(ROW,COL)=BLK
  1. Q
  1. ;
  1. CCP(COUNT) ; -- no diagnosis, look for common problems and convert
  1. N I,X,OLDCNT
  1. S OLDCNT=COUNT
  1. ;
  1. ; -- get the clinic common problem list
  1. D GETLST(CLINIC,"GMP SELECT CLINIC COMMON PROBLEMS",ARY,"",COUNT)
  1. ;
  1. ; -- now convert it to primary icd code save lexicon pointer in piece 6
  1. S I=OLDCNT
  1. F S I=$O(VAR(I)) Q:I="" D
  1. .S X=+VAR(I)
  1. . S:X $P(VAR(I),"^",9)=X,$P(VAR(I),"^",1)=$$ICDONE^LEXU(X)
  1. . I $P(VAR(I),"^",7) S $P(VAR(I),"^",7)=$$ICDONE^LEXU($P(VAR(I),"^",7))
  1. . I $P(VAR(I),"^",8) S $P(VAR(I),"^",8)=$$ICDONE^LEXU($P(VAR(I),"^",8))
  1. Q
  1. ;
  1. TOV ; -- if trying to find Type of Visit codes but list on form
  1. ; uses another interface try this
  1. ;
  1. N INUM
  1. S INUM=0
  1. F S INUM=$O(^IBE(357.6,"B","DG SELECT CPT PROCEDURE CODES",INUM)) Q:'INUM S INUM(INUM)=""
  1. D TOV1
  1. I COUNT=0 D TOV2
  1. Q
  1. ;
  1. TOV1 ; -- first get all lists for blocks named Type of Visit or E&M
  1. N NM,HD
  1. F I=2,3,4,6,8,9 S FORM=$P(SETUP,"^",I) D:+FORM Q:IBQUIT
  1. . ;
  1. . ; -- find blocks on forms
  1. . D GETBLKS Q:'$O(BLK(0))
  1. . S (ROW,COL)=""
  1. . F S ROW=$O(BLK(ROW)) Q:ROW="" S COL="" F S COL=$O(BLK(ROW,COL)) Q:COL="" S BLOCK=$G(BLK(+ROW,+COL)) D
  1. .. ;
  1. .. S NM=$P($G(^IBE(357.1,BLOCK,0)),"^",1)
  1. .. S NM=$TR(NM,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. .. S HD=$P($G(^IBE(357.1,BLOCK,0)),"^",11)
  1. .. S HD=$TR(HD,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. .. I NM["TYPE OF VISIT"!(NM["VISIT TYPE")!(HD["TYPE OF VISIT")!(HD["VISIT TYPE")!(NM["E&M")!(NM["E & M")!(HD["E&M")!(HD["E & M") D
  1. ... S LIST=0
  1. ... F S LIST=$O(^IBE(357.2,"C",BLOCK,LIST)) Q:'LIST D
  1. .... I $D(INUM($P($G(^IBE(357.2,LIST,0)),"^",11))) D COPYLIST^IBDF18A1(LIST,ARY,.COUNT) K BLK(ROW,COL)
  1. Q
  1. ;
  1. TOV2 ; -- get the type of visit codes from cpt lists using filter
  1. S OLDARY=ARY,ARY="IBDTMP"
  1. S @ARY@(0)=+$G(@ARY@(0))
  1. ;
  1. F I=2,3,4,6,8,9 S FORM=$P(SETUP,"^",I) D:+FORM Q:IBQUIT
  1. . ;
  1. . ; -- find blocks on forms
  1. . S (ROW,COL)=""
  1. . F S ROW=$O(BLK(ROW)) Q:ROW="" S COL="" F S COL=$O(BLK(ROW,COL)) Q:COL="" S BLOCK=$G(BLK(+ROW,+COL)) D
  1. .. ;
  1. .. ; -- see if package interface defined for blocks
  1. .. S LIST=0
  1. .. F S LIST=$O(^IBE(357.2,"C",BLOCK,LIST)) Q:'LIST I $D(INUM($P($G(^IBE(357.2,LIST,0)),"^",11))) D COPYLIST^IBDF18A1(LIST,ARY,.COUNT)
  1. D F2^IBDF18A1(OLDARY)
  1. Q
  1. ;
  1. ; -- here are some sample tests for different lists
  1. TEST1 K VAR D GETLST(573,"DG SELECT ICD-9 DIAGNOSIS CODES","VAR",1,"","",DT)
  1. X "ZW VAR"
  1. Q
  1. ;
  1. TEST2 K VAR D GETLST(301,"DG SELECT ICD-9 DIAGNOSIS CODES","VAR",1,"","",DT)
  1. X "ZW VAR"
  1. Q
  1. ;
  1. TEST4 K VAR D GETLST(300,"DG SELECT VISIT TYPE CPT PROCEDURES","VAR",1,"",1,DT)
  1. X "ZW VAR"
  1. Q
  1. ;
  1. TEST5 K VAR D GETLST(300,"PX SELECT IMMUNIZATIONS","VAR",1,DT)
  1. X "ZW VAR"
  1. Q
  1. ;
  1. TEST5A K VAR D GETLST(300,"PX SELECT SKIN TESTS","VAR",1,DT)
  1. X "ZW VAR"
  1. Q
  1. ;
  1. TEST6 K VAR D GETLST(573,"DG SELECT CPT PROCEDURE CODES","VAR",1,"",1,DT)
  1. X "ZW VAR"
  1. Q
  1. ;
  1. TEST7 K VAR D GETLST(573,"DG SELECT VISIT TYPE CPT PROCEDURES","VAR",1,"",1,DT)
  1. X "ZW VAR"
  1. Q
  1. ;
  1. TEST8 ; -- use this to test CPRS ability to retrieve type of visit
  1. ; set clinic := name or internal entry number of clinic or change
  1. ; value for specific clinic
  1. K VAR
  1. I $G(CLINIC)="" S CLINIC=300
  1. I CLINIC'=+CLINIC W !,"Using Clinic: ",CLINIC S CLINIC=$O(^SC("B",CLINIC,0)) W !,"IEN: ",CLINIC,! H 5
  1. X "D VISIT^ORWPCE(.VAR,CLINIC) ZW VAR"
  1. Q
  1. ;
  1. TEST9 K VAR D GETLST(301,"GMP SELECT CLINIC COMMON PROBLEMS","VAR",1)
  1. X "ZW VAR"
  1. Q