| [613] | 1 | PXQFE ;ISL/JVS - DEPENDENT ENTRY COUNT-ENCOUNTERS (SCE) ;5/1/97 08:29
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**4,29**;Aug 12, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | DEC(VISIT,VISUAL,EXPAND) ;Test looking through DD to find fields pointing to the visit entries.
|
|---|
| 5 | ; ENCOUNTER=ENCOUNTER ien to looked up and counted
|
|---|
| 6 | ; VISUAL= Set to 1 if you want and interactive display of what is found
|
|---|
| 7 | ; EXPAND= SET TO 1 TO EXPAND ENTRIES
|
|---|
| 8 | ;
|
|---|
| 9 | ; Look for file and field
|
|---|
| 10 | ;
|
|---|
| 11 | N DD,BECKY,COUNT,FIELD,FILE,GET,PIECE,PX,REF,SNDPIECE,STOP,SUB,VAUGHN
|
|---|
| 12 | N VAR,DEC,DECF,ORG,STS,TYP
|
|---|
| 13 | ;
|
|---|
| 14 | S DD="^DD"
|
|---|
| 15 | S FILE=""
|
|---|
| 16 | F S FILE=$O(@DD@(409.68,0,"PT",FILE)) Q:FILE="" D
|
|---|
| 17 | .S FIELD=""
|
|---|
| 18 | .F S FIELD=$O(@DD@(409.68,0,"PT",FILE,FIELD)) Q:FIELD="" D
|
|---|
| 19 | ..S VDD(FILE,FIELD)=""
|
|---|
| 20 | D REF,QUE
|
|---|
| 21 | K VDDN,VDDR
|
|---|
| 22 | I $G(VISUAL) S VAR="COUNT= "_COUNT W $$RE^PXQUTL(VAR)
|
|---|
| 23 | Q ""
|
|---|
| 24 | ;
|
|---|
| 25 | REF ;Look for all of the regular cross references and other
|
|---|
| 26 | ;
|
|---|
| 27 | S FILE="" F S FILE=$O(VDD(FILE)) Q:FILE="" D
|
|---|
| 28 | .S FIELD="" F S FIELD=$O(VDD(FILE,FIELD)) Q:FIELD="" D
|
|---|
| 29 | ..D REG
|
|---|
| 30 | K VDD
|
|---|
| 31 | Q
|
|---|
| 32 | ;
|
|---|
| 33 | REG ;Look for regular cross references
|
|---|
| 34 | ;
|
|---|
| 35 | S STOP=0
|
|---|
| 36 | I '$D(@DD@(FILE,FIELD,1)) S VDDN(FILE,FIELD)="" Q
|
|---|
| 37 | S SUB=0 F S SUB=$O(@DD@(FILE,FIELD,1,SUB)) Q:SUB="" D
|
|---|
| 38 | .S GET=$G(@DD@(FILE,FIELD,1,SUB,0)) D
|
|---|
| 39 | .I $P(GET,"^",3)']"" S VDDR(FILE,SUB)=FILE_"^"_FIELD_"^"_SUB S STOP=1
|
|---|
| 40 | .E S VDDN(FILE,FIELD)=""
|
|---|
| 41 | Q
|
|---|
| 42 | QUE ;CHECK OUT CROSS REFERENCE
|
|---|
| 43 | ;
|
|---|
| 44 | S FILE="",FIELD="",STOP="",COUNT=0
|
|---|
| 45 | F S FILE=$O(VDDR(FILE)) Q:FILE="" D
|
|---|
| 46 | .S SUB=0,STOP="" F S SUB=$O(VDDR(FILE,SUB)) Q:SUB="" Q:STOP=1 S GET=$G(VDDR(FILE,SUB)) D
|
|---|
| 47 | ..S REF=$G(@DD@($P(GET,"^",1),$P(GET,"^",2),1,$P(GET,"^",3),1))
|
|---|
| 48 | ..I $P(REF,"""",1)["DA(1)" Q
|
|---|
| 49 | ..S PIECE=$P(REF," ",2)
|
|---|
| 50 | ..S SNDPIECE=$P(PIECE,"""",1,2)_""""
|
|---|
| 51 | ..S VAUGHN=$P(PIECE,"""",1,2)_""")"
|
|---|
| 52 | ..I $D(@VAUGHN) D S STOP=1
|
|---|
| 53 | ...S PX=SNDPIECE_",VISIT)"
|
|---|
| 54 | ...I $D(@PX) D
|
|---|
| 55 | ....S BECKY=0 F S BECKY=$O(@PX@(BECKY)) Q:BECKY="" S COUNT=COUNT+1 S DEC=SNDPIECE_","_VISIT_","_BECKY S DECF=$$FILE(SNDPIECE,FILE) W:$G(VISUAL) $$RE^PXQUTL(DEC_" - - - - "_DECF) D
|
|---|
| 56 | .....W:$G(EXPAND) $$EXP^PXQFV(SNDPIECE,BECKY)
|
|---|
| 57 | .....W:$G(PXQSOR) $$SOR^PXQFE(SNDPIECE,BECKY)
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | LINE() ;--LINE
|
|---|
| 61 | Q:'$G(PXQAUDIT) ""
|
|---|
| 62 | W "- - - - -"
|
|---|
| 63 | Q ""
|
|---|
| 64 | ;
|
|---|
| 65 | SOR(ROOT,IEN) ;--SOURCE OF ENCOUNTER
|
|---|
| 66 | N I,REF,REF2,PKG,SOR
|
|---|
| 67 | S REF=$P(ROOT,"""",1)_IEN_")"
|
|---|
| 68 | S REF2=$P(ROOT,"""",1)_IEN
|
|---|
| 69 | I REF["SCE" D
|
|---|
| 70 | .S ORG=$P(^SCE(IEN,0),"^",8)
|
|---|
| 71 | .S STS=$P(^SCE(IEN,0),"^",12) I STS>0 S STS=$P(^SD(409.63,STS,0),"^",1)
|
|---|
| 72 | .S TYP=$P(^SCE(IEN,0),"^",10) I TYP>0 S TYP=$P(^SD(409.1,TYP,0),"^",1)
|
|---|
| 73 | .W $$RE^PXQUTL("ORGINATING PROCESS = "_$S(ORG=1:"APPOINTMENT",ORG=2:"STOP CODE ADDITION",ORG=3:"DISPOSITION",ORG=4:"CREDIT STOP CODE",1:"**NOT STORED**"))
|
|---|
| 74 | .W $$RE^PXQUTL(" CHECK-OUT STATUS = "_STS)
|
|---|
| 75 | .W $$RE^PXQUTL(" APPOINTMENT TYPE = "_TYP)
|
|---|
| 76 | .W $$RE^PXQUTL(" ")
|
|---|
| 77 | Q ""
|
|---|
| 78 | FILE(RT,FILENUM) ;
|
|---|
| 79 | N FILE S FILE=""
|
|---|
| 80 | I '$D(FILENUM) Q "UNKNOWN"
|
|---|
| 81 | FF I $D(^DIC(FILENUM)) D
|
|---|
| 82 | .S FILE=$P($G(^DIC(FILENUM,0)),"^",1)
|
|---|
| 83 | E I $D(^DD(FILENUM)) S FILENUM=+$G(^DD(FILENUM,0,"UP")) G FF
|
|---|
| 84 | Q FILE_" FILE"
|
|---|
