- PXQFE ;ISL/JVS - DEPENDENT ENTRY COUNT-ENCOUNTERS (SCE) ;5/1/97 08:29
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**4,29**;Aug 12, 1996
- ;
- DEC(VISIT,VISUAL,EXPAND) ;Test looking through DD to find fields pointing to the visit entries.
- ; ENCOUNTER=ENCOUNTER ien to looked up and counted
- ; VISUAL= Set to 1 if you want and interactive display of what is found
- ; EXPAND= SET TO 1 TO EXPAND ENTRIES
- ;
- ; Look for file and field
- ;
- N DD,BECKY,COUNT,FIELD,FILE,GET,PIECE,PX,REF,SNDPIECE,STOP,SUB,VAUGHN
- N VAR,DEC,DECF,ORG,STS,TYP
- ;
- S DD="^DD"
- S FILE=""
- F S FILE=$O(@DD@(409.68,0,"PT",FILE)) Q:FILE="" D
- .S FIELD=""
- .F S FIELD=$O(@DD@(409.68,0,"PT",FILE,FIELD)) Q:FIELD="" D
- ..S VDD(FILE,FIELD)=""
- D REF,QUE
- K VDDN,VDDR
- I $G(VISUAL) S VAR="COUNT= "_COUNT W $$RE^PXQUTL(VAR)
- Q ""
- ;
- REF ;Look for all of the regular cross references and other
- ;
- S FILE="" F S FILE=$O(VDD(FILE)) Q:FILE="" D
- .S FIELD="" F S FIELD=$O(VDD(FILE,FIELD)) Q:FIELD="" D
- ..D REG
- K VDD
- Q
- ;
- REG ;Look for regular cross references
- ;
- S STOP=0
- I '$D(@DD@(FILE,FIELD,1)) S VDDN(FILE,FIELD)="" Q
- S SUB=0 F S SUB=$O(@DD@(FILE,FIELD,1,SUB)) Q:SUB="" D
- .S GET=$G(@DD@(FILE,FIELD,1,SUB,0)) D
- .I $P(GET,"^",3)']"" S VDDR(FILE,SUB)=FILE_"^"_FIELD_"^"_SUB S STOP=1
- .E S VDDN(FILE,FIELD)=""
- Q
- QUE ;CHECK OUT CROSS REFERENCE
- ;
- S FILE="",FIELD="",STOP="",COUNT=0
- F S FILE=$O(VDDR(FILE)) Q:FILE="" D
- .S SUB=0,STOP="" F S SUB=$O(VDDR(FILE,SUB)) Q:SUB="" Q:STOP=1 S GET=$G(VDDR(FILE,SUB)) D
- ..S REF=$G(@DD@($P(GET,"^",1),$P(GET,"^",2),1,$P(GET,"^",3),1))
- ..I $P(REF,"""",1)["DA(1)" Q
- ..S PIECE=$P(REF," ",2)
- ..S SNDPIECE=$P(PIECE,"""",1,2)_""""
- ..S VAUGHN=$P(PIECE,"""",1,2)_""")"
- ..I $D(@VAUGHN) D S STOP=1
- ...S PX=SNDPIECE_",VISIT)"
- ...I $D(@PX) D
- ....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
- .....W:$G(EXPAND) $$EXP^PXQFV(SNDPIECE,BECKY)
- .....W:$G(PXQSOR) $$SOR^PXQFE(SNDPIECE,BECKY)
- Q
- ;
- LINE() ;--LINE
- Q:'$G(PXQAUDIT) ""
- W "- - - - -"
- Q ""
- ;
- SOR(ROOT,IEN) ;--SOURCE OF ENCOUNTER
- N I,REF,REF2,PKG,SOR
- S REF=$P(ROOT,"""",1)_IEN_")"
- S REF2=$P(ROOT,"""",1)_IEN
- I REF["SCE" D
- .S ORG=$P(^SCE(IEN,0),"^",8)
- .S STS=$P(^SCE(IEN,0),"^",12) I STS>0 S STS=$P(^SD(409.63,STS,0),"^",1)
- .S TYP=$P(^SCE(IEN,0),"^",10) I TYP>0 S TYP=$P(^SD(409.1,TYP,0),"^",1)
- .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**"))
- .W $$RE^PXQUTL(" CHECK-OUT STATUS = "_STS)
- .W $$RE^PXQUTL(" APPOINTMENT TYPE = "_TYP)
- .W $$RE^PXQUTL(" ")
- Q ""
- FILE(RT,FILENUM) ;
- N FILE S FILE=""
- I '$D(FILENUM) Q "UNKNOWN"
- FF I $D(^DIC(FILENUM)) D
- .S FILE=$P($G(^DIC(FILENUM,0)),"^",1)
- E I $D(^DD(FILENUM)) S FILENUM=+$G(^DD(FILENUM,0,"UP")) G FF
- Q FILE_" FILE"
- PXQFE ;ISL/JVS - DEPENDENT ENTRY COUNT-ENCOUNTERS (SCE) ;5/1/97 08:29
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**4,29**;Aug 12, 1996
- +2 ;
- DEC(VISIT,VISUAL,EXPAND) ;Test looking through DD to find fields pointing to the visit entries.
- +1 ; ENCOUNTER=ENCOUNTER ien to looked up and counted
- +2 ; VISUAL= Set to 1 if you want and interactive display of what is found
- +3 ; EXPAND= SET TO 1 TO EXPAND ENTRIES
- +4 ;
- +5 ; Look for file and field
- +6 ;
- +7 NEW DD,BECKY,COUNT,FIELD,FILE,GET,PIECE,PX,REF,SNDPIECE,STOP,SUB,VAUGHN
- +8 NEW VAR,DEC,DECF,ORG,STS,TYP
- +9 ;
- +10 SET DD="^DD"
- +11 SET FILE=""
- +12 FOR
- SET FILE=$ORDER(@DD@(409.68,0,"PT",FILE))
- IF FILE=""
- QUIT
- Begin DoDot:1
- +13 SET FIELD=""
- +14 FOR
- SET FIELD=$ORDER(@DD@(409.68,0,"PT",FILE,FIELD))
- IF FIELD=""
- QUIT
- Begin DoDot:2
- +15 SET VDD(FILE,FIELD)=""
- End DoDot:2
- End DoDot:1
- +16 DO REF
- DO QUE
- +17 KILL VDDN,VDDR
- +18 IF $GET(VISUAL)
- SET VAR="COUNT= "_COUNT
- WRITE $$RE^PXQUTL(VAR)
- +19 QUIT ""
- +20 ;
- REF ;Look for all of the regular cross references and other
- +1 ;
- +2 SET FILE=""
- FOR
- SET FILE=$ORDER(VDD(FILE))
- IF FILE=""
- QUIT
- Begin DoDot:1
- +3 SET FIELD=""
- FOR
- SET FIELD=$ORDER(VDD(FILE,FIELD))
- IF FIELD=""
- QUIT
- Begin DoDot:2
- +4 DO REG
- End DoDot:2
- End DoDot:1
- +5 KILL VDD
- +6 QUIT
- +7 ;
- REG ;Look for regular cross references
- +1 ;
- +2 SET STOP=0
- +3 IF '$DATA(@DD@(FILE,FIELD,1))
- SET VDDN(FILE,FIELD)=""
- QUIT
- +4 SET SUB=0
- FOR
- SET SUB=$ORDER(@DD@(FILE,FIELD,1,SUB))
- IF SUB=""
- QUIT
- Begin DoDot:1
- +5 SET GET=$GET(@DD@(FILE,FIELD,1,SUB,0))
- Begin DoDot:2
- End DoDot:2
- +6 IF $PIECE(GET,"^",3)']""
- SET VDDR(FILE,SUB)=FILE_"^"_FIELD_"^"_SUB
- SET STOP=1
- +7 IF '$TEST
- SET VDDN(FILE,FIELD)=""
- End DoDot:1
- +8 QUIT
- QUE ;CHECK OUT CROSS REFERENCE
- +1 ;
- +2 SET FILE=""
- SET FIELD=""
- SET STOP=""
- SET COUNT=0
- +3 FOR
- SET FILE=$ORDER(VDDR(FILE))
- IF FILE=""
- QUIT
- Begin DoDot:1
- +4 SET SUB=0
- SET STOP=""
- FOR
- SET SUB=$ORDER(VDDR(FILE,SUB))
- IF SUB=""
- QUIT
- IF STOP=1
- QUIT
- SET GET=$GET(VDDR(FILE,SUB))
- Begin DoDot:2
- +5 SET REF=$GET(@DD@($PIECE(GET,"^",1),$PIECE(GET,"^",2),1,$PIECE(GET,"^",3),1))
- +6 IF $PIECE(REF,"""",1)["DA(1)"
- QUIT
- +7 SET PIECE=$PIECE(REF," ",2)
- +8 SET SNDPIECE=$PIECE(PIECE,"""",1,2)_""""
- +9 SET VAUGHN=$PIECE(PIECE,"""",1,2)_""")"
- +10 IF $DATA(@VAUGHN)
- Begin DoDot:3
- +11 SET PX=SNDPIECE_",VISIT)"
- +12 IF $DATA(@PX)
- Begin DoDot:4
- +13 SET BECKY=0
- FOR
- SET BECKY=$ORDER(@PX@(BECKY))
- IF BECKY=""
- QUIT
- SET COUNT=COUNT+1
- SET DEC=SNDPIECE_","_VISIT_","_BECKY
- SET DECF=$$FILE(SNDPIECE,FILE)
- IF $GET(VISUAL)
- WRITE $$RE^PXQUTL(DEC_" - - - - "_DECF)
- Begin DoDot:5
- +14 IF $GET(EXPAND)
- WRITE $$EXP^PXQFV(SNDPIECE,BECKY)
- +15 IF $GET(PXQSOR)
- WRITE $$SOR^PXQFE(SNDPIECE,BECKY)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- SET STOP=1
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- LINE() ;--LINE
- +1 IF '$GET(PXQAUDIT)
- QUIT ""
- +2 WRITE "- - - - -"
- +3 QUIT ""
- +4 ;
- SOR(ROOT,IEN) ;--SOURCE OF ENCOUNTER
- +1 NEW I,REF,REF2,PKG,SOR
- +2 SET REF=$PIECE(ROOT,"""",1)_IEN_")"
- +3 SET REF2=$PIECE(ROOT,"""",1)_IEN
- +4 IF REF["SCE"
- Begin DoDot:1
- +5 SET ORG=$PIECE(^SCE(IEN,0),"^",8)
- +6 SET STS=$PIECE(^SCE(IEN,0),"^",12)
- IF STS>0
- SET STS=$PIECE(^SD(409.63,STS,0),"^",1)
- +7 SET TYP=$PIECE(^SCE(IEN,0),"^",10)
- IF TYP>0
- SET TYP=$PIECE(^SD(409.1,TYP,0),"^",1)
- +8 WRITE $$RE^PXQUTL("ORGINATING PROCESS = "_$SELECT(ORG=1:"APPOINTMENT",ORG=2:"STOP CODE ADDITION",ORG=3:"DISPOSITION",ORG=4:"CREDIT STOP CODE",1:"**NOT STORED**"))
- +9 WRITE $$RE^PXQUTL(" CHECK-OUT STATUS = "_STS)
- +10 WRITE $$RE^PXQUTL(" APPOINTMENT TYPE = "_TYP)
- +11 WRITE $$RE^PXQUTL(" ")
- End DoDot:1
- +12 QUIT ""
- FILE(RT,FILENUM) ;
- +1 NEW FILE
- SET FILE=""
- +2 IF '$DATA(FILENUM)
- QUIT "UNKNOWN"
- FF IF $DATA(^DIC(FILENUM))
- Begin DoDot:1
- +1 SET FILE=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
- End DoDot:1
- +2 IF '$TEST
- IF $DATA(^DD(FILENUM))
- SET FILENUM=+$GET(^DD(FILENUM,0,"UP"))
- GOTO FF
- +3 QUIT FILE_" FILE"