RORUTL04 ;HCIOFO/BH - Registry Stat Report ; 1/16/02 12:30pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
EN1 D COMP
D DISPLAY
Q
;
COMP N K2,K4,PATIEN,DATE,TMP,CODE,RULE
;
K ^TMP("ROR STAT REPORT")
S K2=0
F S K2=$O(^RORDATA(798,K2)) Q:'K2 D
. S PATIEN=$P(^RORDATA(798,K2,0),"^",1)
. S K4=0,CNT=0 K TMP
. F S K4=$O(^RORDATA(798,K2,1,K4)) Q:'K4 D
. . S CNT=CNT+1
. . S DATE=$P(^RORDATA(798,K2,1,K4,0),"^",2)
. . S CODE=$P(^RORDATA(798,K2,1,K4,0),"^",1)
. . S TMP(DATE)=CODE
. I CNT<1 Q ; No selection rules
. S K1=""
. S K1=$O(TMP(K1))
. S RULE=$$GETRULE(.TMP,CNT,K1)
. S ^TMP("ROR STAT REPORT",RULE,K1,PATIEN)=""
Q
;
GETRULE(TMP,CNT,K1) ;
N MARKER,KK1,RULE1,RESULT
I CNT=1 D Q RESULT
. S RULE1=TMP(K1)
. I RULE1=8 S RESULT="Only_Lab"
. I RULE1'=8 S RESULT="Only_ICD9"
;
S KK1="",MARKER=0
F S KK1=$O(TMP(KK1)) Q:'KK1 D
. I TMP(KK1)=8 S MARKER=1
S SEL=TMP(K1)
I MARKER,SEL=8 Q "BOTHL"
I MARKER,SEL'=8 Q "BOTHI"
Q "All_ICD9"
;
DISPLAY ;
N STRING,I,RES
S STRING="Only_Lab^Only_ICD9^BOTHI^BOTHL^All_ICD9"
F I=1:1:5 D
. S RES=$P(STRING,"^",I)
. D LOOP(RES)
Q
;
LOOP(RES) ;
N NAME,SSN,LABEL,DATE,IEN
S LABEL=RES
I $E(LABEL,1,4)="BOTH" D
. I $E(LABEL,5,5)="I" S LABEL="Both_ICD9_&_Lab. ICD9_was_Earliest."
. I $E(LABEL,5,5)="L" S LABEL="Both_ICD9_&_Lab. Lab_was_Earliest."
W !,"Reason_Added. "_LABEL,!
;
S DATE=""
I $O(^TMP("ROR STAT REPORT",RES,DATE))="" W "No_data_to_display.",!
F S DATE=$O(^TMP("ROR STAT REPORT",RES,DATE)) Q:'DATE D
. S IEN=""
. F S IEN=$O(^TMP("ROR STAT REPORT",RES,DATE,IEN)) Q:'IEN D
. . S NAME=$P(^DPT(IEN,0),"^",1)
. . S NAME=$TR(NAME," ","_")
. . S SSN=$P(^DPT(IEN,0),"^",9)
. . W NAME_" "_SSN_" "_$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3),!
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUTL04 1821 printed Dec 13, 2024@01:43:58 Page 2
RORUTL04 ;HCIOFO/BH - Registry Stat Report ; 1/16/02 12:30pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
EN1 DO COMP
+1 DO DISPLAY
+2 QUIT
+3 ;
COMP NEW K2,K4,PATIEN,DATE,TMP,CODE,RULE
+1 ;
+2 KILL ^TMP("ROR STAT REPORT")
+3 SET K2=0
+4 FOR
SET K2=$ORDER(^RORDATA(798,K2))
if 'K2
QUIT
Begin DoDot:1
+5 SET PATIEN=$PIECE(^RORDATA(798,K2,0),"^",1)
+6 SET K4=0
SET CNT=0
KILL TMP
+7 FOR
SET K4=$ORDER(^RORDATA(798,K2,1,K4))
if 'K4
QUIT
Begin DoDot:2
+8 SET CNT=CNT+1
+9 SET DATE=$PIECE(^RORDATA(798,K2,1,K4,0),"^",2)
+10 SET CODE=$PIECE(^RORDATA(798,K2,1,K4,0),"^",1)
+11 SET TMP(DATE)=CODE
End DoDot:2
+12 ; No selection rules
IF CNT<1
QUIT
+13 SET K1=""
+14 SET K1=$ORDER(TMP(K1))
+15 SET RULE=$$GETRULE(.TMP,CNT,K1)
+16 SET ^TMP("ROR STAT REPORT",RULE,K1,PATIEN)=""
End DoDot:1
+17 QUIT
+18 ;
GETRULE(TMP,CNT,K1) ;
+1 NEW MARKER,KK1,RULE1,RESULT
+2 IF CNT=1
Begin DoDot:1
+3 SET RULE1=TMP(K1)
+4 IF RULE1=8
SET RESULT="Only_Lab"
+5 IF RULE1'=8
SET RESULT="Only_ICD9"
End DoDot:1
QUIT RESULT
+6 ;
+7 SET KK1=""
SET MARKER=0
+8 FOR
SET KK1=$ORDER(TMP(KK1))
if 'KK1
QUIT
Begin DoDot:1
+9 IF TMP(KK1)=8
SET MARKER=1
End DoDot:1
+10 SET SEL=TMP(K1)
+11 IF MARKER
IF SEL=8
QUIT "BOTHL"
+12 IF MARKER
IF SEL'=8
QUIT "BOTHI"
+13 QUIT "All_ICD9"
+14 ;
DISPLAY ;
+1 NEW STRING,I,RES
+2 SET STRING="Only_Lab^Only_ICD9^BOTHI^BOTHL^All_ICD9"
+3 FOR I=1:1:5
Begin DoDot:1
+4 SET RES=$PIECE(STRING,"^",I)
+5 DO LOOP(RES)
End DoDot:1
+6 QUIT
+7 ;
LOOP(RES) ;
+1 NEW NAME,SSN,LABEL,DATE,IEN
+2 SET LABEL=RES
+3 IF $EXTRACT(LABEL,1,4)="BOTH"
Begin DoDot:1
+4 IF $EXTRACT(LABEL,5,5)="I"
SET LABEL="Both_ICD9_&_Lab. ICD9_was_Earliest."
+5 IF $EXTRACT(LABEL,5,5)="L"
SET LABEL="Both_ICD9_&_Lab. Lab_was_Earliest."
End DoDot:1
+6 WRITE !,"Reason_Added. "_LABEL,!
+7 ;
+8 SET DATE=""
+9 IF $ORDER(^TMP("ROR STAT REPORT",RES,DATE))=""
WRITE "No_data_to_display.",!
+10 FOR
SET DATE=$ORDER(^TMP("ROR STAT REPORT",RES,DATE))
if 'DATE
QUIT
Begin DoDot:1
+11 SET IEN=""
+12 FOR
SET IEN=$ORDER(^TMP("ROR STAT REPORT",RES,DATE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+13 SET NAME=$PIECE(^DPT(IEN,0),"^",1)
+14 SET NAME=$TRANSLATE(NAME," ","_")
+15 SET SSN=$PIECE(^DPT(IEN,0),"^",9)
+16 WRITE NAME_" "_SSN_" "_$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3),!
End DoDot:2
End DoDot:1
+17 ;
+18 ;
