IBDF18A ;ALB/CJM/AAS - ENCOUNTER FORM - utilities for PCE ;04/12/94
;;3.0;AUTOMATED INFO COLLECTION SYS;**34,38,51,63,69**;APR 24, 1997;Build 2
;
;
GLL(CLINIC,INTRFACE,ARY,FILTER,PAR5,PAR6,ENCDATE) ; -- get lots of lists in one call
; -- input see GETLST but pass interface by reference expects
; INTRFACE(n) = name of select list in package interface file
;
; -- PAR5 => not currently used
; -- PAR6 => not currently used
;
; -- output see GETLST
N X,COUNT
S COUNT=0
S X="" F S X=$O(INTRFACE(X)) Q:X="" D GETLST(CLINIC,INTRFACE(X),ARY,$G(FILTER),.COUNT,$G(PAR6),ENCDATE)
Q
;
GETLST(CLINIC,INTRFACE,ARY,FILTER,COUNT,MODIFIER,ENCDATE) ; -- returns any specified selection list for a clinic
; -- input CLINIC = pointer to hospital location file for clinic
; INTRFACE = name of selection list in package interface file
; ARY = name of array to return list in
; FILTER = predefined filters (optional, default = 1)
; 1 = must be selection list
; 2 = only visit cpts on list
; ENCDATE = encounter date
; MODIFIER = if modifiers are to be passed, 1=yes send modifiers
;
; -- output The format of the returned array is as follows
; @ARY@(0) = count of array element (0 of nothing found)
; @ARY@(1) = ^group header
; @ARY@(2) = P1 := cpt or icd code / ien of other items
; P2 := user defined text
; p3 := quantity (number of occurrences)
; p6 := user defined expanded text to send to PCE
; p7 := second code or item defined for line item
; p8 := third code or item defined for line item
; p9 := associated clinical lexicon term
;
; @ARY@(2,"MODIFIER",0)=count of CPT Modifiers for entry
; @ARY@(2,"MODIFIER",1)=2 character CPT Modifier value
; @ARY@(2,"MODIFIER",2)=2 character CPT Modifier value
; @ARY@(2,"MODIFIER",k+1)=2 character CPT Modifier value
;
; @ARY@(k) = ^next group header
; @ARY@(k+1) = problem ien or cpt or icd code^user define text
;
; -- output modification for patch 34:
; Narrative to Send to PCE (instead of printed text)
; field (2.01) in file 357.3, added as piece 6 of @ary@(n)
;
; if additional codes for an item (diagnosis) are added to
; item, they are added as pieces 7 and/or 8 of @ary@(n).
;
; if a type of visit code is requested and none found, will
; automatically look first for blocks named type of visit and
; second for filtered codes using regular cpt blocks.
;
; if a diagnosis block it requested and none found will
; automatically look for Clinic Common Problem List and
; then convert it to look like a diagnosis list
;
N I,J,X,Y,INUM,IBQUIT,FORM,SETUP,LIST,BLOCK,OLDARY,IBDTMP,ROW,COL,BLK
N LIST1,PACKAGE,IBDIMPDA,IBDCSYS
K ^TMP("IBDUP",$J)
S (IBQUIT,LIST)=0
S PACKAGE=$E(INTRFACE,1,30)
;
;Setup array containing NAME of the Package Interface file
;This is the second parameter passed by PCE, TIU, & CPRS
S LIST1("DG SELECT CPT PROCEDURE CODES")=""
S LIST1("DG SELECT ICD-9 DIAGNOSIS CODE")=""
S LIST1("DG SELECT ICD DIAGNOSIS CODES")=""
S LIST1("DG SELECT ICD-10 DIAGNOSIS COD")=""
S LIST1("DG SELECT VISIT TYPE CPT PROCE")=""
S LIST1("GMP INPUT CLINIC COMMON PROBLE")=""
S LIST1("GMP PATIENT ACTIVE PROBLEMS")=""
;
S COUNT=$G(COUNT,0)
I $G(FILTER)<1 S FILTER=1 ;default value=1
I FILTER>1 S OLDARY=ARY,ARY="IBDTMP"
S @ARY@(0)=+$G(@ARY@(0))
I $G(CLINIC)="" G GETLSTQ
I $G(^SC(CLINIC,0))="" G GETLSTQ
I $G(INTRFACE)="" G GETLSTQ
I INTRFACE["SELECT ICD",$D(LIST1(PACKAGE)) D
. S IBDIMPDA=$$IMPDATE^IBDUTICD("10D"),IBDCSYS=1 I ENCDATE'<IBDIMPDA S IBDCSYS=30
. I IBDCSYS=1 S INUM=$O(^IBE(357.6,"B","DG SELECT ICD-9 DIAGNOSIS CODE",0))
. I IBDCSYS=30 S INUM=$O(^IBE(357.6,"B","DG SELECT ICD-10 DIAGNOSIS COD",0))
E S INUM=$O(^IBE(357.6,"B",$E(INTRFACE,1,30),0))
;
; -- find forms defined for clinic
; piece 2 = basic form
; piece 3,4,6 = supplemental forms
S SETUP=$G(^SD(409.95,+$O(^SD(409.95,"B",CLINIC,0)),0))
G:SETUP="" GETLSTQ
F I=2,3,4,6,8,9 S FORM=$P(SETUP,"^",I) D Q:IBQUIT
.;
.; -- find blocks on forms
.Q:'FORM
. D GETBLKS Q:'$O(BLK(0))
. S (ROW,COL)=""
. 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
..;
..; -- see if package interface defined for blocks
..S LIST=0
..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)
;I COUNT D URH^IBDF18A1
S @ARY@(0)=COUNT
I FILTER=2 D F2^IBDF18A1(OLDARY)
;
I COUNT=0 D
.I $E(INTRFACE,1,30)=$E("DG SELECT VISIT TYPE CPT PROCEDURES",1,30) D TOV
;
; -- always check for both diagnosis and clinic common problems when
; looking for diagnosis, return in diagnosis format
I $E(INTRFACE,1,30)=$E("DG SELECT ICD-9 DIAGNOSIS CODES",1,30) D CCP(COUNT)
;This routine checks list that have CPT & ICD codes for CSV.
D CHKLST^IBDF18A2:$D(LIST1(PACKAGE))
;
K ^TMP("IBDUP",$J)
;
GETLSTQ Q
;
GETBLKS ; -- get the blocks for a form in row,column order
K BLK
N ROW,COL
S BLK=0
F S BLK=$O(^IBE(357.1,"C",FORM,BLK)) Q:'BLK D
. S ROW=$P($G(^IBE(357.1,+BLK,0)),"^",4),COL=$P(^IBE(357.1,+BLK,0),"^",5)
. Q:ROW=""!(COL="")
. S BLK(ROW,COL)=BLK
Q
;
CCP(COUNT) ; -- no diagnosis, look for common problems and convert
N I,X,OLDCNT
S OLDCNT=COUNT
;
; -- get the clinic common problem list
D GETLST(CLINIC,"GMP SELECT CLINIC COMMON PROBLEMS",ARY,"",COUNT)
;
; -- now convert it to primary icd code save lexicon pointer in piece 6
S I=OLDCNT
F S I=$O(VAR(I)) Q:I="" D
.S X=+VAR(I)
. S:X $P(VAR(I),"^",9)=X,$P(VAR(I),"^",1)=$$ICDONE^LEXU(X)
. I $P(VAR(I),"^",7) S $P(VAR(I),"^",7)=$$ICDONE^LEXU($P(VAR(I),"^",7))
. I $P(VAR(I),"^",8) S $P(VAR(I),"^",8)=$$ICDONE^LEXU($P(VAR(I),"^",8))
Q
;
TOV ; -- if trying to find Type of Visit codes but list on form
; uses another interface try this
;
N INUM
S INUM=0
F S INUM=$O(^IBE(357.6,"B","DG SELECT CPT PROCEDURE CODES",INUM)) Q:'INUM S INUM(INUM)=""
D TOV1
I COUNT=0 D TOV2
Q
;
TOV1 ; -- first get all lists for blocks named Type of Visit or E&M
N NM,HD
F I=2,3,4,6,8,9 S FORM=$P(SETUP,"^",I) D:+FORM Q:IBQUIT
. ;
. ; -- find blocks on forms
. D GETBLKS Q:'$O(BLK(0))
. S (ROW,COL)=""
. 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
.. ;
.. S NM=$P($G(^IBE(357.1,BLOCK,0)),"^",1)
.. S NM=$TR(NM,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
.. S HD=$P($G(^IBE(357.1,BLOCK,0)),"^",11)
.. S HD=$TR(HD,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
.. 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
... S LIST=0
... F S LIST=$O(^IBE(357.2,"C",BLOCK,LIST)) Q:'LIST D
.... I $D(INUM($P($G(^IBE(357.2,LIST,0)),"^",11))) D COPYLIST^IBDF18A1(LIST,ARY,.COUNT) K BLK(ROW,COL)
Q
;
TOV2 ; -- get the type of visit codes from cpt lists using filter
S OLDARY=ARY,ARY="IBDTMP"
S @ARY@(0)=+$G(@ARY@(0))
;
F I=2,3,4,6,8,9 S FORM=$P(SETUP,"^",I) D:+FORM Q:IBQUIT
. ;
. ; -- find blocks on forms
. S (ROW,COL)=""
. 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
.. ;
.. ; -- see if package interface defined for blocks
.. S LIST=0
.. 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)
D F2^IBDF18A1(OLDARY)
Q
;
; -- here are some sample tests for different lists
TEST1 K VAR D GETLST(573,"DG SELECT ICD-9 DIAGNOSIS CODES","VAR",1,"","",DT)
X "ZW VAR"
Q
;
TEST2 K VAR D GETLST(301,"DG SELECT ICD-9 DIAGNOSIS CODES","VAR",1,"","",DT)
X "ZW VAR"
Q
;
TEST4 K VAR D GETLST(300,"DG SELECT VISIT TYPE CPT PROCEDURES","VAR",1,"",1,DT)
X "ZW VAR"
Q
;
TEST5 K VAR D GETLST(300,"PX SELECT IMMUNIZATIONS","VAR",1,DT)
X "ZW VAR"
Q
;
TEST5A K VAR D GETLST(300,"PX SELECT SKIN TESTS","VAR",1,DT)
X "ZW VAR"
Q
;
TEST6 K VAR D GETLST(573,"DG SELECT CPT PROCEDURE CODES","VAR",1,"",1,DT)
X "ZW VAR"
Q
;
TEST7 K VAR D GETLST(573,"DG SELECT VISIT TYPE CPT PROCEDURES","VAR",1,"",1,DT)
X "ZW VAR"
Q
;
TEST8 ; -- use this to test CPRS ability to retrieve type of visit
; set clinic := name or internal entry number of clinic or change
; value for specific clinic
K VAR
I $G(CLINIC)="" S CLINIC=300
I CLINIC'=+CLINIC W !,"Using Clinic: ",CLINIC S CLINIC=$O(^SC("B",CLINIC,0)) W !,"IEN: ",CLINIC,! H 5
X "D VISIT^ORWPCE(.VAR,CLINIC) ZW VAR"
Q
;
TEST9 K VAR D GETLST(301,"GMP SELECT CLINIC COMMON PROBLEMS","VAR",1)
X "ZW VAR"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDF18A 9225 printed Dec 13, 2024@02:50:50 Page 2
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
+2 ;
+3 ;
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
+2 ; INTRFACE(n) = name of select list in package interface file
+3 ;
+4 ; -- PAR5 => not currently used
+5 ; -- PAR6 => not currently used
+6 ;
+7 ; -- output see GETLST
+8 NEW X,COUNT
+9 SET COUNT=0
+10 SET X=""
FOR
SET X=$ORDER(INTRFACE(X))
if X=""
QUIT
DO GETLST(CLINIC,INTRFACE(X),ARY,$GET(FILTER),.COUNT,$GET(PAR6),ENCDATE)
+11 QUIT
+12 ;
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
+2 ; INTRFACE = name of selection list in package interface file
+3 ; ARY = name of array to return list in
+4 ; FILTER = predefined filters (optional, default = 1)
+5 ; 1 = must be selection list
+6 ; 2 = only visit cpts on list
+7 ; ENCDATE = encounter date
+8 ; MODIFIER = if modifiers are to be passed, 1=yes send modifiers
+9 ;
+10 ; -- output The format of the returned array is as follows
+11 ; @ARY@(0) = count of array element (0 of nothing found)
+12 ; @ARY@(1) = ^group header
+13 ; @ARY@(2) = P1 := cpt or icd code / ien of other items
+14 ; P2 := user defined text
+15 ; p3 := quantity (number of occurrences)
+16 ; p6 := user defined expanded text to send to PCE
+17 ; p7 := second code or item defined for line item
+18 ; p8 := third code or item defined for line item
+19 ; p9 := associated clinical lexicon term
+20 ;
+21 ; @ARY@(2,"MODIFIER",0)=count of CPT Modifiers for entry
+22 ; @ARY@(2,"MODIFIER",1)=2 character CPT Modifier value
+23 ; @ARY@(2,"MODIFIER",2)=2 character CPT Modifier value
+24 ; @ARY@(2,"MODIFIER",k+1)=2 character CPT Modifier value
+25 ;
+26 ; @ARY@(k) = ^next group header
+27 ; @ARY@(k+1) = problem ien or cpt or icd code^user define text
+28 ;
+29 ; -- output modification for patch 34:
+30 ; Narrative to Send to PCE (instead of printed text)
+31 ; field (2.01) in file 357.3, added as piece 6 of @ary@(n)
+32 ;
+33 ; if additional codes for an item (diagnosis) are added to
+34 ; item, they are added as pieces 7 and/or 8 of @ary@(n).
+35 ;
+36 ; if a type of visit code is requested and none found, will
+37 ; automatically look first for blocks named type of visit and
+38 ; second for filtered codes using regular cpt blocks.
+39 ;
+40 ; if a diagnosis block it requested and none found will
+41 ; automatically look for Clinic Common Problem List and
+42 ; then convert it to look like a diagnosis list
+43 ;
+44 NEW I,J,X,Y,INUM,IBQUIT,FORM,SETUP,LIST,BLOCK,OLDARY,IBDTMP,ROW,COL,BLK
+45 NEW LIST1,PACKAGE,IBDIMPDA,IBDCSYS
+46 KILL ^TMP("IBDUP",$JOB)
+47 SET (IBQUIT,LIST)=0
+48 SET PACKAGE=$EXTRACT(INTRFACE,1,30)
+49 ;
+50 ;Setup array containing NAME of the Package Interface file
+51 ;This is the second parameter passed by PCE, TIU, & CPRS
+52 SET LIST1("DG SELECT CPT PROCEDURE CODES")=""
+53 SET LIST1("DG SELECT ICD-9 DIAGNOSIS CODE")=""
+54 SET LIST1("DG SELECT ICD DIAGNOSIS CODES")=""
+55 SET LIST1("DG SELECT ICD-10 DIAGNOSIS COD")=""
+56 SET LIST1("DG SELECT VISIT TYPE CPT PROCE")=""
+57 SET LIST1("GMP INPUT CLINIC COMMON PROBLE")=""
+58 SET LIST1("GMP PATIENT ACTIVE PROBLEMS")=""
+59 ;
+60 SET COUNT=$GET(COUNT,0)
+61 ;default value=1
IF $GET(FILTER)<1
SET FILTER=1
+62 IF FILTER>1
SET OLDARY=ARY
SET ARY="IBDTMP"
+63 SET @ARY@(0)=+$GET(@ARY@(0))
+64 IF $GET(CLINIC)=""
GOTO GETLSTQ
+65 IF $GET(^SC(CLINIC,0))=""
GOTO GETLSTQ
+66 IF $GET(INTRFACE)=""
GOTO GETLSTQ
+67 IF INTRFACE["SELECT ICD"
IF $DATA(LIST1(PACKAGE))
Begin DoDot:1
+68 SET IBDIMPDA=$$IMPDATE^IBDUTICD("10D")
SET IBDCSYS=1
IF ENCDATE'<IBDIMPDA
SET IBDCSYS=30
+69 IF IBDCSYS=1
SET INUM=$ORDER(^IBE(357.6,"B","DG SELECT ICD-9 DIAGNOSIS CODE",0))
+70 IF IBDCSYS=30
SET INUM=$ORDER(^IBE(357.6,"B","DG SELECT ICD-10 DIAGNOSIS COD",0))
End DoDot:1
+71 IF '$TEST
SET INUM=$ORDER(^IBE(357.6,"B",$EXTRACT(INTRFACE,1,30),0))
+72 ;
+73 ; -- find forms defined for clinic
+74 ; piece 2 = basic form
+75 ; piece 3,4,6 = supplemental forms
+76 SET SETUP=$GET(^SD(409.95,+$ORDER(^SD(409.95,"B",CLINIC,0)),0))
+77 if SETUP=""
GOTO GETLSTQ
+78 FOR I=2,3,4,6,8,9
SET FORM=$PIECE(SETUP,"^",I)
Begin DoDot:1
+79 ;
+80 ; -- find blocks on forms
+81 if 'FORM
QUIT
+82 DO GETBLKS
if '$ORDER(BLK(0))
QUIT
+83 SET (ROW,COL)=""
+84 FOR
SET ROW=$ORDER(BLK(ROW))
if ROW=""
QUIT
SET COL=""
FOR
SET COL=$ORDER(BLK(ROW,COL))
if COL=""
QUIT
SET BLOCK=$GET(BLK(+ROW,+COL))
Begin DoDot:2
+85 ;
+86 ; -- see if package interface defined for blocks
+87 SET LIST=0
+88 FOR
SET LIST=$ORDER(^IBE(357.2,"C",BLOCK,LIST))
if 'LIST
QUIT
IF $PIECE($GET(^IBE(357.2,LIST,0)),"^",11)=INUM
DO COPYLIST^IBDF18A1(LIST,ARY,.COUNT)
End DoDot:2
End DoDot:1
if IBQUIT
QUIT
+89 ;I COUNT D URH^IBDF18A1
+90 SET @ARY@(0)=COUNT
+91 IF FILTER=2
DO F2^IBDF18A1(OLDARY)
+92 ;
+93 IF COUNT=0
Begin DoDot:1
+94 IF $EXTRACT(INTRFACE,1,30)=$EXTRACT("DG SELECT VISIT TYPE CPT PROCEDURES",1,30)
DO TOV
End DoDot:1
+95 ;
+96 ; -- always check for both diagnosis and clinic common problems when
+97 ; looking for diagnosis, return in diagnosis format
+98 IF $EXTRACT(INTRFACE,1,30)=$EXTRACT("DG SELECT ICD-9 DIAGNOSIS CODES",1,30)
DO CCP(COUNT)
+99 ;This routine checks list that have CPT & ICD codes for CSV.
+100 if $DATA(LIST1(PACKAGE))
DO CHKLST^IBDF18A2
+101 ;
+102 KILL ^TMP("IBDUP",$JOB)
+103 ;
GETLSTQ QUIT
+1 ;
GETBLKS ; -- get the blocks for a form in row,column order
+1 KILL BLK
+2 NEW ROW,COL
+3 SET BLK=0
+4 FOR
SET BLK=$ORDER(^IBE(357.1,"C",FORM,BLK))
if 'BLK
QUIT
Begin DoDot:1
+5 SET ROW=$PIECE($GET(^IBE(357.1,+BLK,0)),"^",4)
SET COL=$PIECE(^IBE(357.1,+BLK,0),"^",5)
+6 if ROW=""!(COL="")
QUIT
+7 SET BLK(ROW,COL)=BLK
End DoDot:1
+8 QUIT
+9 ;
CCP(COUNT) ; -- no diagnosis, look for common problems and convert
+1 NEW I,X,OLDCNT
+2 SET OLDCNT=COUNT
+3 ;
+4 ; -- get the clinic common problem list
+5 DO GETLST(CLINIC,"GMP SELECT CLINIC COMMON PROBLEMS",ARY,"",COUNT)
+6 ;
+7 ; -- now convert it to primary icd code save lexicon pointer in piece 6
+8 SET I=OLDCNT
+9 FOR
SET I=$ORDER(VAR(I))
if I=""
QUIT
Begin DoDot:1
+10 SET X=+VAR(I)
+11 if X
SET $PIECE(VAR(I),"^",9)=X
SET $PIECE(VAR(I),"^",1)=$$ICDONE^LEXU(X)
+12 IF $PIECE(VAR(I),"^",7)
SET $PIECE(VAR(I),"^",7)=$$ICDONE^LEXU($PIECE(VAR(I),"^",7))
+13 IF $PIECE(VAR(I),"^",8)
SET $PIECE(VAR(I),"^",8)=$$ICDONE^LEXU($PIECE(VAR(I),"^",8))
End DoDot:1
+14 QUIT
+15 ;
TOV ; -- if trying to find Type of Visit codes but list on form
+1 ; uses another interface try this
+2 ;
+3 NEW INUM
+4 SET INUM=0
+5 FOR
SET INUM=$ORDER(^IBE(357.6,"B","DG SELECT CPT PROCEDURE CODES",INUM))
if 'INUM
QUIT
SET INUM(INUM)=""
+6 DO TOV1
+7 IF COUNT=0
DO TOV2
+8 QUIT
+9 ;
TOV1 ; -- first get all lists for blocks named Type of Visit or E&M
+1 NEW NM,HD
+2 FOR I=2,3,4,6,8,9
SET FORM=$PIECE(SETUP,"^",I)
if +FORM
Begin DoDot:1
+3 ;
+4 ; -- find blocks on forms
+5 DO GETBLKS
if '$ORDER(BLK(0))
QUIT
+6 SET (ROW,COL)=""
+7 FOR
SET ROW=$ORDER(BLK(ROW))
if ROW=""
QUIT
SET COL=""
FOR
SET COL=$ORDER(BLK(ROW,COL))
if COL=""
QUIT
SET BLOCK=$GET(BLK(+ROW,+COL))
Begin DoDot:2
+8 ;
+9 SET NM=$PIECE($GET(^IBE(357.1,BLOCK,0)),"^",1)
+10 SET NM=$TRANSLATE(NM,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+11 SET HD=$PIECE($GET(^IBE(357.1,BLOCK,0)),"^",11)
+12 SET HD=$TRANSLATE(HD,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+13 IF 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")
Begin DoDot:3
+14 SET LIST=0
+15 FOR
SET LIST=$ORDER(^IBE(357.2,"C",BLOCK,LIST))
if 'LIST
QUIT
Begin DoDot:4
+16 IF $DATA(INUM($PIECE($GET(^IBE(357.2,LIST,0)),"^",11)))
DO COPYLIST^IBDF18A1(LIST,ARY,.COUNT)
KILL BLK(ROW,COL)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
if IBQUIT
QUIT
+17 QUIT
+18 ;
TOV2 ; -- get the type of visit codes from cpt lists using filter
+1 SET OLDARY=ARY
SET ARY="IBDTMP"
+2 SET @ARY@(0)=+$GET(@ARY@(0))
+3 ;
+4 FOR I=2,3,4,6,8,9
SET FORM=$PIECE(SETUP,"^",I)
if +FORM
Begin DoDot:1
+5 ;
+6 ; -- find blocks on forms
+7 SET (ROW,COL)=""
+8 FOR
SET ROW=$ORDER(BLK(ROW))
if ROW=""
QUIT
SET COL=""
FOR
SET COL=$ORDER(BLK(ROW,COL))
if COL=""
QUIT
SET BLOCK=$GET(BLK(+ROW,+COL))
Begin DoDot:2
+9 ;
+10 ; -- see if package interface defined for blocks
+11 SET LIST=0
+12 FOR
SET LIST=$ORDER(^IBE(357.2,"C",BLOCK,LIST))
if 'LIST
QUIT
IF $DATA(INUM($PIECE($GET(^IBE(357.2,LIST,0)),"^",11)))
DO COPYLIST^IBDF18A1(LIST,ARY,.COUNT)
End DoDot:2
End DoDot:1
if IBQUIT
QUIT
+13 DO F2^IBDF18A1(OLDARY)
+14 QUIT
+15 ;
+16 ; -- here are some sample tests for different lists
TEST1 KILL VAR
DO GETLST(573,"DG SELECT ICD-9 DIAGNOSIS CODES","VAR",1,"","",DT)
+1 XECUTE "ZW VAR"
+2 QUIT
+3 ;
TEST2 KILL VAR
DO GETLST(301,"DG SELECT ICD-9 DIAGNOSIS CODES","VAR",1,"","",DT)
+1 XECUTE "ZW VAR"
+2 QUIT
+3 ;
TEST4 KILL VAR
DO GETLST(300,"DG SELECT VISIT TYPE CPT PROCEDURES","VAR",1,"",1,DT)
+1 XECUTE "ZW VAR"
+2 QUIT
+3 ;
TEST5 KILL VAR
DO GETLST(300,"PX SELECT IMMUNIZATIONS","VAR",1,DT)
+1 XECUTE "ZW VAR"
+2 QUIT
+3 ;
TEST5A KILL VAR
DO GETLST(300,"PX SELECT SKIN TESTS","VAR",1,DT)
+1 XECUTE "ZW VAR"
+2 QUIT
+3 ;
TEST6 KILL VAR
DO GETLST(573,"DG SELECT CPT PROCEDURE CODES","VAR",1,"",1,DT)
+1 XECUTE "ZW VAR"
+2 QUIT
+3 ;
TEST7 KILL VAR
DO GETLST(573,"DG SELECT VISIT TYPE CPT PROCEDURES","VAR",1,"",1,DT)
+1 XECUTE "ZW VAR"
+2 QUIT
+3 ;
TEST8 ; -- use this to test CPRS ability to retrieve type of visit
+1 ; set clinic := name or internal entry number of clinic or change
+2 ; value for specific clinic
+3 KILL VAR
+4 IF $GET(CLINIC)=""
SET CLINIC=300
+5 IF CLINIC'=+CLINIC
WRITE !,"Using Clinic: ",CLINIC
SET CLINIC=$ORDER(^SC("B",CLINIC,0))
WRITE !,"IEN: ",CLINIC,!
HANG 5
+6 XECUTE "D VISIT^ORWPCE(.VAR,CLINIC) ZW VAR"
+7 QUIT
+8 ;
TEST9 KILL VAR
DO GETLST(301,"GMP SELECT CLINIC COMMON PROBLEMS","VAR",1)
+1 XECUTE "ZW VAR"
+2 QUIT
