- 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 Feb 19, 2025@00:17:15 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