VENPCCX1 ; ILC/SLC/GIS - FUNCTION CALLS TO SUPPORT GUI CONFIGURATION INTERFACE ;
;;1.2t1;PCC+;;NOV 15, 2001
;
; COPYRITE INFORMATIX LABORATORIES, 2000
;
GET(EF,LIST,GRP) ; EP-GIVEN EF NAME, LIST NAME, & PT GRP NAME, RETURNT LIST OF ITEMS
; OUTPUT FORMAT: EF^LIST^PT GRP^MAX ITEMS ALLOWED^ITEM #1^...
NEW N EIEN,LIEN,GNO,CNT,X,Y,%,IEN,IX,LMN,STG,MAX
I $L($G(EF)),$L($G(LIST)),$L($G(GRP))
E Q ""
INIT ;
I EF S EIEN=EF,EF=$P($G(^VEN(7.41,+EIEN,0)),U)
E S EIEN=$O(^VEN(7.41,"B",EF,0)) I 'EIEN Q ""
I LIST S LIEN=LIST,LIST=$P($G(^VEN(7.98,+LIEN,0)),U)
E S LIEN=$O(^VEN(7.98,"B",LIST,0)) I 'LIEN Q ""
I GRP S %=$$GRP1(GRP),GNO=+%,GRP=$P(%,U,2) I 'GNO Q ""
E S GNO=$$GNO(GRP) I 'GNO Q ""
I $D(^VEN(7.98,LIEN,0)),$D(^VEN(7.41,EIEN,0))
E Q ""
S LMN=$P($G(^VEN(7.98,LIEN,0)),U,3) I '$L(LMN) Q ""
S IX=GNO_LMN
S MAX=$$MAX^VENPCCMP(EIEN,LIEN) I 'MAX Q ""
BLD S IEN=0,STG=EF_U_LIST_U_GRP_U_MAX
F S IEN=$O(^VEN(7.93,"AC",IX,IEN)) Q:'IEN D
. S X=$G(^VEN(7.93,IEN,0))
. S STG=STG_U_$P(X,U)_";"_$P(X,U,6)_";"_IEN_";"_$P(X,U,5)
. Q
Q STG
;
GNO(GRP) ; EP-GROUP NUMBER
I '$L(GRP) Q ""
N X,Y
S X=$P($G(^DD(19707.93,.09,0)),U,3)
S Y=$F(X,GRP),X=$E(X,1,Y)
S X=$P(X,";",$L(X,";")-1)
Q +X
;
STUFF(STG) ; EP-STUFF A LIST INTO THE SYSTEM PREF FILE
; INPUT FORMAT: EF NAME^LIST NAME^PATIENT GRP NAME^MAX ALLOWED^ITEM1;CODE1^ITEM2;CODE2^...
N LIST,LIEN,GRP,GNO,X
I '$L(STG) Q
S LIST=$P(STG,U,2)
S LIEN=$O(^VEN(7.98,"B",LIST,0)) I 'LIEN Q
S GRP=$P(STG,U,3)
S GNO=$$GNO(GRP) I 'GNO Q
S X=$P(STG,U,5,99)
D SAVE^VENPCCMP(X,LIEN,GNO)
Q
;
EF() ; EP-RETURN A LIST OF AVAILABLE ENCOUNTER FORMS
S EIEN=0 S STG=""
F S EIEN=$O(^VEN(7.41,EIEN)) Q:'EIEN D
. S X=$P($G(^VEN(7.41,EIEN,0)),U)
. I $L(STG) S STG=STG_U
. S STG=STG_X_";"_EIEN
. Q
Q STG
;
LIST(EF) ; EP-RETURN A ^ DELIMITED STRING CONTAINING ALL LISTS
N STG,LIST,LIEN
S STG="",LIST=0
F S LIST=$O(^VEN(7.98,"B",LIST)) Q:LIST="" D
. I LIST="HEALTH MAINTENANCE REMINDERS" Q
. I LIST="PHYSICAL EXAM" Q
. S LIEN=$O(^VEN(7.98,"B",LIST,0)) I 'LIEN Q
. I $L(STG) S STG=STG_U
. S STG=STG_LIST_";"_LIEN
. Q
Q STG
;
GRP() ; RETURN NAMES OF PATIENT GROUPS
S X=$P($G(^DD(19707.93,.09,0)),U,3) I '$L(X) Q
S STG=""
F I=1:1 S Y=$P(X,";",I) Q:Y="" D
. S Z=$P(Y,":",2)
. I $L(STG) S STG=STG_U
. S STG=STG_Z_";"_I
. Q
Q STG
;
DEPT() ; EP-SUPER BILL DEPTS
N NAME,IEN,STG
S NAME="" S STG=""
F S NAME=$O(^VEN(7.95,"B",NAME)) Q:NAME="" D
. I NAME["TELEPHONE" Q
. I NAME="CHART REVIEW" Q
. S IEN=$O(^VEN(7.95,"B",NAME,0)) I 'IEN Q
. I $L(STG) S STG=STG_U
. S STG=STG_NAME_";"_IEN
. Q
Q STG
;
GRP1(GNO) ;
N X,Y,Z
I 'GNO Q ""
S X=$P($G(^DD(19707.93,.09,0)),U,3) I '$L(X) Q ""
I X'[(GNO_":") Q ""
S Y=$P(X,(GNO_":"),2)
S Z=$P(Y,";") I '$L(Z) Q ""
Q GNO_U_Z
;
HS() ; EP-RETURN A LIST OF HEALTH SUMMARY TYPES
N NAME,HIEN,X,%,STG
S STG="",NAME=""
F S NAME=$O(^APCHSCTL("B",NAME)) Q:NAME="" D
. S HIEN=$O(^APCHSCTL("B",NAME,0))
. I 'HIEN Q
. I $L(STG) S STG=STG_U
. S STG=STG_NAME_";"_HIEN
. Q
Q STG
;
ADD(EF,CPT,PGRP,NAME,CODE) ; EP-ADD AN ENTRY TO A LIST
N LIST
I '$D(^VEN(7.41,+$G(EF),0)) Q 0
I '$D(^VEN(7.98,+$G(CPT),0)) Q 0
I $G(PGRP),PGRP=PGRP\1,PGRP>0,PGRP<5
E Q 0
I $G(NAME)="" Q 0
S LIST=$$LIST^VENPCCMP(+EF,+CPT,PGRP) I '$L(LIST) Q 0
S LIST=LIST_U_NAME_";"_$G(CODE)_";;"
Q $$SUB^VENPCCMP(LIST,EF,CPT,PGRP)
;
DEL(IEN) ; EP-DELETE AN ENTRY FROM THE LIST
S X=$G(^VEN(7.93,+$G(IEN),0)) I X="" Q 0
S EF=$P(X,U,11) I 'EF Q 0
S PGRP=$P(X,U,9) I 'PGRP Q 0
S %=$P(X,U,8) I %="" Q 0
S %=$E(%) I %="" Q
S CPT=$O(^VEN(7.98,"AD",%,0)) I 'CPT Q 0
I '$D(^VEN(7.41,+$G(EF),0)) Q 0
I '$D(^VEN(7.98,+$G(CPT),0)) Q 0
I $G(PGRP),PGRP=PGRP\1,PGRP>0,PGRP<5
E Q 0
I '$D(^VEN(7.93,+$G(IEN),0)) Q 0
S DIK="^VEN(7.93,",DA=IEN D ^DIK ; DELETE THE ENTRY AND RESET
S LIST=$$LIST^VENPCCMP(+EF,+CPT,PGRP) I '$L(LIST) Q 0
Q $$SUB^VENPCCMP(LIST,EF,CPT,PGRP)
;
;
CP(CIEN) ; EP-CLINIC PREFERENCES
N STG,X,Y,%,PIEN,HIEN,EIEN,CLIEN,ENAME,HNAME,PNAME,CLNAME
S STG=$G(^VEN(7.95,+$G(CIEN),2)) I STG="" Q ""
S PIEN=$P(STG,U,2),HIEN=$P(STG,U,6),EIEN=$P(STG,U,5)
S PNAME=$P($G(^VA(200,+PIEN,0)),U)
S ENAME=$P($G(^VEN(7.41,+EIEN,0)),U)
S HNAME=$P($G(^APCHSCTL(+HIEN,0)),U)
S CLIEN=$P(^VEN(7.95,+$G(CIEN),0),U,4)
S CLNAME=$P($G(^DIC(40.7,CLIEN,0)),U)
S X=PNAME_";"_PIEN_U_ENAME_";"_EIEN_U_HNAME_";"_HIEN_U_CLIEN_";"_CLNAME
Q X
;
ER() ; EP-EMERGENCY DEPARTMENTS
N CIEN,X,STG,CNAME
S STG="",CIEN=0
F S CIEN=$O(^VEN(7.95,CIEN)) Q:'CIEN D
. S X=$P($G(^VEN(7.95,CIEN,2)),U,12) I 'X Q
. S CNAME=$P($G(^VEN(7.95,CIEN,0)),U)
. I $L(STG) S STG=STG_U
. S STG=STG_CNAME_";"_CIEN
. Q
Q STG
;
VENPCCX1 ; ILC/SLC/GIS - FUNCTION CALLS TO SUPPORT GUI CONFIGURATION INTERFACE ;
+1 ;;1.2t1;PCC+;;NOV 15, 2001
+2 ;
+3 ; COPYRITE INFORMATIX LABORATORIES, 2000
+4 ;
GET(EF,LIST,GRP) ; EP-GIVEN EF NAME, LIST NAME, & PT GRP NAME, RETURNT LIST OF ITEMS
+1 ; OUTPUT FORMAT: EF^LIST^PT GRP^MAX ITEMS ALLOWED^ITEM #1^...
NEW NEW EIEN,LIEN,GNO,CNT,X,Y,%,IEN,IX,LMN,STG,MAX
+1 IF $LENGTH($GET(EF))
IF $LENGTH($GET(LIST))
IF $LENGTH($GET(GRP))
+2 IF '$TEST
QUIT ""
INIT ;
+1 IF EF
SET EIEN=EF
SET EF=$PIECE($GET(^VEN(7.41,+EIEN,0)),U)
+2 IF '$TEST
SET EIEN=$ORDER(^VEN(7.41,"B",EF,0))
IF 'EIEN
QUIT ""
+3 IF LIST
SET LIEN=LIST
SET LIST=$PIECE($GET(^VEN(7.98,+LIEN,0)),U)
+4 IF '$TEST
SET LIEN=$ORDER(^VEN(7.98,"B",LIST,0))
IF 'LIEN
QUIT ""
+5 IF GRP
SET %=$$GRP1(GRP)
SET GNO=+%
SET GRP=$PIECE(%,U,2)
IF 'GNO
QUIT ""
+6 IF '$TEST
SET GNO=$$GNO(GRP)
IF 'GNO
QUIT ""
+7 IF $DATA(^VEN(7.98,LIEN,0))
IF $DATA(^VEN(7.41,EIEN,0))
+8 IF '$TEST
QUIT ""
+9 SET LMN=$PIECE($GET(^VEN(7.98,LIEN,0)),U,3)
IF '$LENGTH(LMN)
QUIT ""
+10 SET IX=GNO_LMN
+11 SET MAX=$$MAX^VENPCCMP(EIEN,LIEN)
IF 'MAX
QUIT ""
BLD SET IEN=0
SET STG=EF_U_LIST_U_GRP_U_MAX
+1 FOR
SET IEN=$ORDER(^VEN(7.93,"AC",IX,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+2 SET X=$GET(^VEN(7.93,IEN,0))
+3 SET STG=STG_U_$PIECE(X,U)_";"_$PIECE(X,U,6)_";"_IEN_";"_$PIECE(X,U,5)
+4 QUIT
End DoDot:1
+5 QUIT STG
+6 ;
GNO(GRP) ; EP-GROUP NUMBER
+1 IF '$LENGTH(GRP)
QUIT ""
+2 NEW X,Y
+3 SET X=$PIECE($GET(^DD(19707.93,.09,0)),U,3)
+4 SET Y=$FIND(X,GRP)
SET X=$EXTRACT(X,1,Y)
+5 SET X=$PIECE(X,";",$LENGTH(X,";")-1)
+6 QUIT +X
+7 ;
STUFF(STG) ; EP-STUFF A LIST INTO THE SYSTEM PREF FILE
+1 ; INPUT FORMAT: EF NAME^LIST NAME^PATIENT GRP NAME^MAX ALLOWED^ITEM1;CODE1^ITEM2;CODE2^...
+2 NEW LIST,LIEN,GRP,GNO,X
+3 IF '$LENGTH(STG)
QUIT
+4 SET LIST=$PIECE(STG,U,2)
+5 SET LIEN=$ORDER(^VEN(7.98,"B",LIST,0))
IF 'LIEN
QUIT
+6 SET GRP=$PIECE(STG,U,3)
+7 SET GNO=$$GNO(GRP)
IF 'GNO
QUIT
+8 SET X=$PIECE(STG,U,5,99)
+9 DO SAVE^VENPCCMP(X,LIEN,GNO)
+10 QUIT
+11 ;
EF() ; EP-RETURN A LIST OF AVAILABLE ENCOUNTER FORMS
+1 SET EIEN=0
SET STG=""
+2 FOR
SET EIEN=$ORDER(^VEN(7.41,EIEN))
IF 'EIEN
QUIT
Begin DoDot:1
+3 SET X=$PIECE($GET(^VEN(7.41,EIEN,0)),U)
+4 IF $LENGTH(STG)
SET STG=STG_U
+5 SET STG=STG_X_";"_EIEN
+6 QUIT
End DoDot:1
+7 QUIT STG
+8 ;
LIST(EF) ; EP-RETURN A ^ DELIMITED STRING CONTAINING ALL LISTS
+1 NEW STG,LIST,LIEN
+2 SET STG=""
SET LIST=0
+3 FOR
SET LIST=$ORDER(^VEN(7.98,"B",LIST))
IF LIST=""
QUIT
Begin DoDot:1
+4 IF LIST="HEALTH MAINTENANCE REMINDERS"
QUIT
+5 IF LIST="PHYSICAL EXAM"
QUIT
+6 SET LIEN=$ORDER(^VEN(7.98,"B",LIST,0))
IF 'LIEN
QUIT
+7 IF $LENGTH(STG)
SET STG=STG_U
+8 SET STG=STG_LIST_";"_LIEN
+9 QUIT
End DoDot:1
+10 QUIT STG
+11 ;
GRP() ; RETURN NAMES OF PATIENT GROUPS
+1 SET X=$PIECE($GET(^DD(19707.93,.09,0)),U,3)
IF '$LENGTH(X)
QUIT
+2 SET STG=""
+3 FOR I=1:1
SET Y=$PIECE(X,";",I)
IF Y=""
QUIT
Begin DoDot:1
+4 SET Z=$PIECE(Y,":",2)
+5 IF $LENGTH(STG)
SET STG=STG_U
+6 SET STG=STG_Z_";"_I
+7 QUIT
End DoDot:1
+8 QUIT STG
+9 ;
DEPT() ; EP-SUPER BILL DEPTS
+1 NEW NAME,IEN,STG
+2 SET NAME=""
SET STG=""
+3 FOR
SET NAME=$ORDER(^VEN(7.95,"B",NAME))
IF NAME=""
QUIT
Begin DoDot:1
+4 IF NAME["TELEPHONE"
QUIT
+5 IF NAME="CHART REVIEW"
QUIT
+6 SET IEN=$ORDER(^VEN(7.95,"B",NAME,0))
IF 'IEN
QUIT
+7 IF $LENGTH(STG)
SET STG=STG_U
+8 SET STG=STG_NAME_";"_IEN
+9 QUIT
End DoDot:1
+10 QUIT STG
+11 ;
GRP1(GNO) ;
+1 NEW X,Y,Z
+2 IF 'GNO
QUIT ""
+3 SET X=$PIECE($GET(^DD(19707.93,.09,0)),U,3)
IF '$LENGTH(X)
QUIT ""
+4 IF X'[(GNO_":")
QUIT ""
+5 SET Y=$PIECE(X,(GNO_":"),2)
+6 SET Z=$PIECE(Y,";")
IF '$LENGTH(Z)
QUIT ""
+7 QUIT GNO_U_Z
+8 ;
HS() ; EP-RETURN A LIST OF HEALTH SUMMARY TYPES
+1 NEW NAME,HIEN,X,%,STG
+2 SET STG=""
SET NAME=""
+3 FOR
SET NAME=$ORDER(^APCHSCTL("B",NAME))
IF NAME=""
QUIT
Begin DoDot:1
+4 SET HIEN=$ORDER(^APCHSCTL("B",NAME,0))
+5 IF 'HIEN
QUIT
+6 IF $LENGTH(STG)
SET STG=STG_U
+7 SET STG=STG_NAME_";"_HIEN
+8 QUIT
End DoDot:1
+9 QUIT STG
+10 ;
ADD(EF,CPT,PGRP,NAME,CODE) ; EP-ADD AN ENTRY TO A LIST
+1 NEW LIST
+2 IF '$DATA(^VEN(7.41,+$GET(EF),0))
QUIT 0
+3 IF '$DATA(^VEN(7.98,+$GET(CPT),0))
QUIT 0
+4 IF $GET(PGRP)
IF PGRP=PGRP\1
IF PGRP>0
IF PGRP<5
+5 IF '$TEST
QUIT 0
+6 IF $GET(NAME)=""
QUIT 0
+7 SET LIST=$$LIST^VENPCCMP(+EF,+CPT,PGRP)
IF '$LENGTH(LIST)
QUIT 0
+8 SET LIST=LIST_U_NAME_";"_$GET(CODE)_";;"
+9 QUIT $$SUB^VENPCCMP(LIST,EF,CPT,PGRP)
+10 ;
DEL(IEN) ; EP-DELETE AN ENTRY FROM THE LIST
+1 SET X=$GET(^VEN(7.93,+$GET(IEN),0))
IF X=""
QUIT 0
+2 SET EF=$PIECE(X,U,11)
IF 'EF
QUIT 0
+3 SET PGRP=$PIECE(X,U,9)
IF 'PGRP
QUIT 0
+4 SET %=$PIECE(X,U,8)
IF %=""
QUIT 0
+5 SET %=$EXTRACT(%)
IF %=""
QUIT
+6 SET CPT=$ORDER(^VEN(7.98,"AD",%,0))
IF 'CPT
QUIT 0
+7 IF '$DATA(^VEN(7.41,+$GET(EF),0))
QUIT 0
+8 IF '$DATA(^VEN(7.98,+$GET(CPT),0))
QUIT 0
+9 IF $GET(PGRP)
IF PGRP=PGRP\1
IF PGRP>0
IF PGRP<5
+10 IF '$TEST
QUIT 0
+11 IF '$DATA(^VEN(7.93,+$GET(IEN),0))
QUIT 0
+12 ; DELETE THE ENTRY AND RESET
SET DIK="^VEN(7.93,"
SET DA=IEN
DO ^DIK
+13 SET LIST=$$LIST^VENPCCMP(+EF,+CPT,PGRP)
IF '$LENGTH(LIST)
QUIT 0
+14 QUIT $$SUB^VENPCCMP(LIST,EF,CPT,PGRP)
+15 ;
+16 ;
CP(CIEN) ; EP-CLINIC PREFERENCES
+1 NEW STG,X,Y,%,PIEN,HIEN,EIEN,CLIEN,ENAME,HNAME,PNAME,CLNAME
+2 SET STG=$GET(^VEN(7.95,+$GET(CIEN),2))
IF STG=""
QUIT ""
+3 SET PIEN=$PIECE(STG,U,2)
SET HIEN=$PIECE(STG,U,6)
SET EIEN=$PIECE(STG,U,5)
+4 SET PNAME=$PIECE($GET(^VA(200,+PIEN,0)),U)
+5 SET ENAME=$PIECE($GET(^VEN(7.41,+EIEN,0)),U)
+6 SET HNAME=$PIECE($GET(^APCHSCTL(+HIEN,0)),U)
+7 SET CLIEN=$PIECE(^VEN(7.95,+$GET(CIEN),0),U,4)
+8 SET CLNAME=$PIECE($GET(^DIC(40.7,CLIEN,0)),U)
+9 SET X=PNAME_";"_PIEN_U_ENAME_";"_EIEN_U_HNAME_";"_HIEN_U_CLIEN_";"_CLNAME
+10 QUIT X
+11 ;
ER() ; EP-EMERGENCY DEPARTMENTS
+1 NEW CIEN,X,STG,CNAME
+2 SET STG=""
SET CIEN=0
+3 FOR
SET CIEN=$ORDER(^VEN(7.95,CIEN))
IF 'CIEN
QUIT
Begin DoDot:1
+4 SET X=$PIECE($GET(^VEN(7.95,CIEN,2)),U,12)
IF 'X
QUIT
+5 SET CNAME=$PIECE($GET(^VEN(7.95,CIEN,0)),U)
+6 IF $LENGTH(STG)
SET STG=STG_U
+7 SET STG=STG_CNAME_";"_CIEN
+8 QUIT
End DoDot:1
+9 QUIT STG
+10 ;
