PXRMGECX ;SLC/JVS - GEC Debug Utilities ;08/21/2003 08:54
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
Q
PROMPT ; Prompt for Correct Report
N Y,X
K DIR
S DIR("A")="Select Option or ^ to Exit"
S DIR("A",1)="These Reports are to Help with Degugging of Problems"
S DIR("A",2)="**It could take 5 minutes !! or more to Complete Reports"
I $D(^DISV(DUZ,"PXRMGEC","BG")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","BG"))
S DIR(0)="S^B:Brief Health Factor Review;D:Detailed Health Factor Review"
D ^DIR
K DIR("A"),DIR("B"),DIR(0)
I Y="B" D PR1
I Y="D" D PR
Q:$D(DIRUT)!($D(DIROUT))
S ^DISV(DUZ,"PXRMGEC","BG")=Y
Q
;
DAS ;GET IENS OF TOP LEVEL DIALOGS WITH GEC IN THE IDENTITY FIELD
F GECI="GEC1","GEC2","GEC3","GECF" D
.S GECX=0 F S GECX=$O(^PXRMD(801.41,"AC",GECI,GECX)) Q:GECX="" S GECDA(GECX,GECI)=""
Q
;
;
SCREEN(IEN) ;Screen for use in GEC Dialog Group
N REFB,REF10,TREE,DGIEN,IENN,GECX,GECI,DGDA,DGNA
N DIASYN
S DGNA="",DGDA=0,OK=0
S REFB="^PXRMD(801.41,""B"")"
S REF10="^PXRMD(801.41)"
S DGNA="VA-" F S DGNA=$O(@REFB@(DGNA)) Q:DGNA'["VA-" D
.S DGDA=$O(@REFB@(DGNA,0))
.I $P($P($G(^PXRMD(801.41,DGDA,1)),"^",5),";",1)=IEN!($$MUL(IEN,DGDA)) D
..I $P($G(^PXRMD(801.41,DGDA,0)),"^",1)["HF GEC "!($P($G(^PXRMD(801.41,DGDA,0)),"^",1)["DG GEC ") S DGIEN=DGDA
..I $D(DGIEN) S TREE(DGIEN)=""
Q:'$D(DGIEN) OK
ST I $D(^PXRMD(801.41,"AD",DGIEN)) D
.S IENN=0 F S IENN=$O(^PXRMD(801.41,"AD",DGIEN,IENN)) Q:IENN=""!(OK=1) D
..I $D(GECDA(IENN)) S OK=1,HFDIA(IEN,$O(GECDA(IENN,"")))="" S ^TMP("PXRMGECX",$J,"TEXT",IENN,DGIEN,IEN)=""
..I OK=1 K TREE
..I OK=0 S TREE(IENN)=""
REDO I $D(TREE) D
.S TIEN=0 F S TIEN=$O(TREE(TIEN)) Q:TIEN=""!(OK=1) D S TIEN=0
..S IENN=0 F S IENN=$O(^PXRMD(801.41,"AD",TIEN,IENN)) Q:IENN="" D
...I $D(GECDA(IENN)) S OK=1,HFDIA(IEN,$O(GECDA(IENN,"")))="" S ^TMP("PXRMGECX",$J,"TEXT",IENN,DGIEN,IEN)=""
...I OK=0,'$D(DONE(IENN)) S TREE(IENN)=""
..K TREE(TIEN) S DONE(TIEN)=""
I OK=0&($D(TREE)) G REDO
K TREE,IENN,DONE
Q OK
;
MUL(IEN,DGDA) ;SEARCH ADDITONAL FINDINGS
N YES
S YES=0
I $D(^PXRMD(801.41,DGDA,3,"B",IEN_";AUTTHF(")) S YES=1
Q YES
;
HF ;Gather Health Factors
K ^TMP("PXRMGEC",$J,"MAN"),^TMP("PXRMGEC",$J,"MAN1")
N IEN,CAT,DIA,CATDA,CATNA,FNA,REF,ANS,STOP
S IEN=0
F S IEN=$O(^AUTTHF(IEN)) Q:IEN<1 D
.Q:$P($G(^AUTTHF(IEN,0)),"^",11)=1
.S FNA=$P($G(^AUTTHF(IEN,0)),"^",1)
.S CAT=$P($G(^AUTTHF(IEN,0)),"^",10)
.I CAT="F" D
..Q:$P($G(^AUTTHF(IEN,0)),"^",11)=1
..S CATDA=$P($G(^AUTTHF(IEN,0)),"^",3)
..Q:CATDA=""
..Q:$P($G(^AUTTHF(CATDA,0)),"^",11)=1
..S CATNA=$P($G(^AUTTHF(CATDA,0)),"^",1)
..I CATNA["GEC" D
...I $P($G(^AUTTHF(CATDA,0)),"^",9)'="" D
....Q:$P($G(^AUTTHF(CATDA,0)),"^",11)=1
....S DIASYN=$P($G(^AUTTHF(CATDA,0)),"^",9)
....S ANS=$P($G(^AUTTHF(IEN,0)),"^",9),VAL=$S(ANS'="":$P(ANS," ",$L(ANS," ")),1:0)
....S ^TMP("PXRMGEC",$J,"MAN",DIASYN,CATNA,FNA,VAL,IEN,$$SCREEN(IEN))=""
....I $D(HFDIA(IEN)) S ^TMP("PXRMGEC",$J,"MAN1",$O(HFDIA(IEN,"")),CATNA,FNA,VAL,IEN,$$SCREEN(IEN))=""
Q
;
PR ;
N REFM,STOPNA,TIEN,VO
S REF="^TMP(""PXRMGEC"",$J,""MAN"")"
S REFM="^TMP(""PXRMGEC"",$J,""MATCH"")"
S X="IOINHI;IOINLOW;IORVON;IORVOFF"
D ENDR^%ZISS
D DAS,MATCHB^PXRMGECY,MATCHB^PXRMGECZ
N DIACNT,CATCNT,FACCNT,IEN,VAL,STOPCNT,NEWFNA,SYN,TERM
S (DIACNT,CATCNT,FACCNT,STOPCNT)=0
D HF
;
;
S DIASYN="" F S DIASYN=$O(@REF@(DIASYN)) Q:DIASYN="" D
.S DIACNT=DIACNT+1
.W !!!,DIACNT_". Dialog- GEC REFERRAL "_$P(DIASYN," ",2,4)
.S CATNA="" F S CATNA=$O(@REF@(DIASYN,CATNA)) Q:CATNA="" D
..K @REFM@(CATNA)
..S CATCNT=CATCNT+1
..W !!,DIACNT_". Dialog- GEC REFERRAL "_$P(DIASYN," ",2,4)
..W !!,CATCNT_". Category- ",CATNA
..W !," Synonum- "_DIASYN
..W !!," Health Factors---"
..S FNA="" F S FNA=$O(@REF@(DIASYN,CATNA,FNA)) Q:FNA="" D
...S FACCNT=FACCNT+1
...S VAL=$O(@REF@(DIASYN,CATNA,FNA,-1))
...S IEN=$O(@REF@(DIASYN,CATNA,FNA,VAL,0))
...S STOP=$O(@REF@(DIASYN,CATNA,FNA,VAL,IEN,-1))
...I STOP=0 S STOPCNT=STOPCNT+1
...S STOPNA=$S(STOP=0:"(((NOT IN USE)))",1:"")
...S VO=0
...I STOPNA'="" S VO=1
...W !,FACCNT_". " I VO W IORVON
...W FNA," ",STOPNA,IORVOFF I $L(FNA)>40 W " ",IORVON,$L(FNA),IORVOFF
...W !,?19,$S('$D(@REFM@(FNA,IEN)):IORVON,1:""),"ien- "_IEN," (",$O(@REFM@(FNA,0))_")",IORVOFF I '$D(@REFM@(FNA)) W !
...W ?17,IORVON,$S($D(@REFM@(FNA)):"",1:"**NOT Originally Released Name") W IORVOFF K @REFM@(FNA)
...S SYN=$P($G(^AUTTHF($O(^AUTTHF("B",FNA,0)),0)),"^",9)
...S TERM=$O(^PXRMD(811.5,"AF",IEN_";AUTTHF(",0))
...W !,?18,$S(TERM="":IORVON,1:""),"Term- ",$S(TERM="":"NO TERM",1:$P($G(^PXRMD(811.5,TERM,0)),"^",1)),IORVOFF
...I SYN="" W !,?17,IORVON,$S(SYN="":"**Synonum Missing",1:"syn- "_SYN),IORVOFF
...E W !,?19,$S(SYN="":"**Synonum Missing",1:"syn- "_SYN)
...W !,?19,"val- "_VAL,!
...W IORVOFF
I $D(@REFM) W !!,?7,"**Missing Original GEC Health Factors**"
I $D(@REFM) S FNA="" F S FNA=$O(@REFM@(FNA)) Q:FNA="" D
.W !,?10,FNA
W !
W !,"Categories - "_$J(CATCNT,3)
W !,"Health Factors- "_$J(FACCNT,3)
W !,"Not in Use - "_$J(STOPCNT,3)
W !,"Used Factors - ",$J(((FACCNT+CATCNT)-STOPCNT),3)
W !
W !,"-----------------------------END OF REPORT ----------------------"
K ^TMP("PXRMGEC",$J,"MAN"),^TMP("PXRMGEC",$J,"MAN1"),HFDIA
K ^TMP("PXRMGEC",$J,"MATCH")
D KILL^%ZISS
Q
;
;
;
PR1 S REF="^TMP(""PXRMGEC"",$J,""MAN1"")"
S X="IOINHI;IOINLOW;IORVON;IORVOFF"
D ENDR^%ZISS
D DAS,MATCHB^PXRMGECY,MATCHB^PXRMGECZ
N DIACNT,CATCNT,FACCNT,IEN,VAL,STOPCNT,XCNT
S (DIACNT,CATCNT,FACCNT,STOPCNT)=0
D HF
;
DISPLAY ;REPORT DISPLAY
;
S DIASYN="" F S DIASYN=$O(@REF@(DIASYN)) Q:DIASYN="" D
.S DIACNT=DIACNT+1,CATCNT=0
.W !!,DIACNT," Dialog- "_$P($G(^PXRMD(801.41,$O(^PXRMD(801.41,"AC",DIASYN,"")),0)),"^",1)
.S CATNA="" F S CATNA=$O(@REF@(DIASYN,CATNA)) Q:CATNA="" D
..S CATCNT=CATCNT+1
..W !!,?2,CATCNT_". Category- ",CATNA
..W !,?7," Ref# (score) Health Factors---"
..N FNACNT S FNACNT=0
..S FNA="" F S FNA=$O(@REF@(DIASYN,CATNA,FNA)) Q:FNA="" D
...S XCNT=FACCNT,FACCNT=FACCNT+1,FNACNT=FNACNT+1
...S VAL=$O(@REF@(DIASYN,CATNA,FNA,-1))
...S IEN=$O(@REF@(DIASYN,CATNA,FNA,VAL,0))
...S STOP=$O(@REF@(DIASYN,CATNA,FNA,VAL,IEN,-1))
...I STOP=0 S FACCNT=XCNT
...I STOP=0 S STOPCNT=STOPCNT+1 Q
...S STOPNA=$S(STOP=0:"(((NOT IN USE)))",1:"")
...N COMB S COMB=DIACNT_"."_CATCNT_"."_FNACNT_" ("_VAL_")"
...S VO=0
...I STOPNA'="" S VO=1
...W !," " I VO W IORVON
...W ?11,COMB," "_FNA," ",STOPNA,IORVOFF W " "
...;==================================================
...W IORVOFF
W !!,"Health Factors- "_$J(FACCNT,3)
W !
W !,"-----------------------------END OF REPORT ----------------------"
K ^TMP("PXRMGEC",$J,"MAN"),^TMP("PXRMGEC",$J,"MAN1"),HFDIA
K ^TMP("PXRMGEC",$J,"MATCH")
D KILL^%ZISS
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMGECX 6886 printed Oct 16, 2024@17:46:46 Page 2
PXRMGECX ;SLC/JVS - GEC Debug Utilities ;08/21/2003 08:54
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 QUIT
PROMPT ; Prompt for Correct Report
+1 NEW Y,X
+2 KILL DIR
+3 SET DIR("A")="Select Option or ^ to Exit"
+4 SET DIR("A",1)="These Reports are to Help with Degugging of Problems"
+5 SET DIR("A",2)="**It could take 5 minutes !! or more to Complete Reports"
+6 IF $DATA(^DISV(DUZ,"PXRMGEC","BG"))
SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","BG"))
+7 SET DIR(0)="S^B:Brief Health Factor Review;D:Detailed Health Factor Review"
+8 DO ^DIR
+9 KILL DIR("A"),DIR("B"),DIR(0)
+10 IF Y="B"
DO PR1
+11 IF Y="D"
DO PR
+12 if $DATA(DIRUT)!($DATA(DIROUT))
QUIT
+13 SET ^DISV(DUZ,"PXRMGEC","BG")=Y
+14 QUIT
+15 ;
DAS ;GET IENS OF TOP LEVEL DIALOGS WITH GEC IN THE IDENTITY FIELD
+1 FOR GECI="GEC1","GEC2","GEC3","GECF"
Begin DoDot:1
+2 SET GECX=0
FOR
SET GECX=$ORDER(^PXRMD(801.41,"AC",GECI,GECX))
if GECX=""
QUIT
SET GECDA(GECX,GECI)=""
End DoDot:1
+3 QUIT
+4 ;
+5 ;
SCREEN(IEN) ;Screen for use in GEC Dialog Group
+1 NEW REFB,REF10,TREE,DGIEN,IENN,GECX,GECI,DGDA,DGNA
+2 NEW DIASYN
+3 SET DGNA=""
SET DGDA=0
SET OK=0
+4 SET REFB="^PXRMD(801.41,""B"")"
+5 SET REF10="^PXRMD(801.41)"
+6 SET DGNA="VA-"
FOR
SET DGNA=$ORDER(@REFB@(DGNA))
if DGNA'["VA-"
QUIT
Begin DoDot:1
+7 SET DGDA=$ORDER(@REFB@(DGNA,0))
+8 IF $PIECE($PIECE($GET(^PXRMD(801.41,DGDA,1)),"^",5),";",1)=IEN!($$MUL(IEN,DGDA))
Begin DoDot:2
+9 IF $PIECE($GET(^PXRMD(801.41,DGDA,0)),"^",1)["HF GEC "!($PIECE($GET(^PXRMD(801.41,DGDA,0)),"^",1)["DG GEC ")
SET DGIEN=DGDA
+10 IF $DATA(DGIEN)
SET TREE(DGIEN)=""
End DoDot:2
End DoDot:1
+11 if '$DATA(DGIEN)
QUIT OK
ST IF $DATA(^PXRMD(801.41,"AD",DGIEN))
Begin DoDot:1
+1 SET IENN=0
FOR
SET IENN=$ORDER(^PXRMD(801.41,"AD",DGIEN,IENN))
if IENN=""!(OK=1)
QUIT
Begin DoDot:2
+2 IF $DATA(GECDA(IENN))
SET OK=1
SET HFDIA(IEN,$ORDER(GECDA(IENN,"")))=""
SET ^TMP("PXRMGECX",$JOB,"TEXT",IENN,DGIEN,IEN)=""
+3 IF OK=1
KILL TREE
+4 IF OK=0
SET TREE(IENN)=""
End DoDot:2
End DoDot:1
REDO IF $DATA(TREE)
Begin DoDot:1
+1 SET TIEN=0
FOR
SET TIEN=$ORDER(TREE(TIEN))
if TIEN=""!(OK=1)
QUIT
Begin DoDot:2
+2 SET IENN=0
FOR
SET IENN=$ORDER(^PXRMD(801.41,"AD",TIEN,IENN))
if IENN=""
QUIT
Begin DoDot:3
+3 IF $DATA(GECDA(IENN))
SET OK=1
SET HFDIA(IEN,$ORDER(GECDA(IENN,"")))=""
SET ^TMP("PXRMGECX",$JOB,"TEXT",IENN,DGIEN,IEN)=""
+4 IF OK=0
IF '$DATA(DONE(IENN))
SET TREE(IENN)=""
End DoDot:3
+5 KILL TREE(TIEN)
SET DONE(TIEN)=""
End DoDot:2
SET TIEN=0
End DoDot:1
+6 IF OK=0&($DATA(TREE))
GOTO REDO
+7 KILL TREE,IENN,DONE
+8 QUIT OK
+9 ;
MUL(IEN,DGDA) ;SEARCH ADDITONAL FINDINGS
+1 NEW YES
+2 SET YES=0
+3 IF $DATA(^PXRMD(801.41,DGDA,3,"B",IEN_";AUTTHF("))
SET YES=1
+4 QUIT YES
+5 ;
HF ;Gather Health Factors
+1 KILL ^TMP("PXRMGEC",$JOB,"MAN"),^TMP("PXRMGEC",$JOB,"MAN1")
+2 NEW IEN,CAT,DIA,CATDA,CATNA,FNA,REF,ANS,STOP
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(^AUTTHF(IEN))
if IEN<1
QUIT
Begin DoDot:1
+5 if $PIECE($GET(^AUTTHF(IEN,0)),"^",11)=1
QUIT
+6 SET FNA=$PIECE($GET(^AUTTHF(IEN,0)),"^",1)
+7 SET CAT=$PIECE($GET(^AUTTHF(IEN,0)),"^",10)
+8 IF CAT="F"
Begin DoDot:2
+9 if $PIECE($GET(^AUTTHF(IEN,0)),"^",11)=1
QUIT
+10 SET CATDA=$PIECE($GET(^AUTTHF(IEN,0)),"^",3)
+11 if CATDA=""
QUIT
+12 if $PIECE($GET(^AUTTHF(CATDA,0)),"^",11)=1
QUIT
+13 SET CATNA=$PIECE($GET(^AUTTHF(CATDA,0)),"^",1)
+14 IF CATNA["GEC"
Begin DoDot:3
+15 IF $PIECE($GET(^AUTTHF(CATDA,0)),"^",9)'=""
Begin DoDot:4
+16 if $PIECE($GET(^AUTTHF(CATDA,0)),"^",11)=1
QUIT
+17 SET DIASYN=$PIECE($GET(^AUTTHF(CATDA,0)),"^",9)
+18 SET ANS=$PIECE($GET(^AUTTHF(IEN,0)),"^",9)
SET VAL=$SELECT(ANS'="":$PIECE(ANS," ",$LENGTH(ANS," ")),1:0)
+19 SET ^TMP("PXRMGEC",$JOB,"MAN",DIASYN,CATNA,FNA,VAL,IEN,$$SCREEN(IEN))=""
+20 IF $DATA(HFDIA(IEN))
SET ^TMP("PXRMGEC",$JOB,"MAN1",$ORDER(HFDIA(IEN,"")),CATNA,FNA,VAL,IEN,$$SCREEN(IEN))=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
PR ;
+1 NEW REFM,STOPNA,TIEN,VO
+2 SET REF="^TMP(""PXRMGEC"",$J,""MAN"")"
+3 SET REFM="^TMP(""PXRMGEC"",$J,""MATCH"")"
+4 SET X="IOINHI;IOINLOW;IORVON;IORVOFF"
+5 DO ENDR^%ZISS
+6 DO DAS
DO MATCHB^PXRMGECY
DO MATCHB^PXRMGECZ
+7 NEW DIACNT,CATCNT,FACCNT,IEN,VAL,STOPCNT,NEWFNA,SYN,TERM
+8 SET (DIACNT,CATCNT,FACCNT,STOPCNT)=0
+9 DO HF
+10 ;
+11 ;
+12 SET DIASYN=""
FOR
SET DIASYN=$ORDER(@REF@(DIASYN))
if DIASYN=""
QUIT
Begin DoDot:1
+13 SET DIACNT=DIACNT+1
+14 WRITE !!!,DIACNT_". Dialog- GEC REFERRAL "_$PIECE(DIASYN," ",2,4)
+15 SET CATNA=""
FOR
SET CATNA=$ORDER(@REF@(DIASYN,CATNA))
if CATNA=""
QUIT
Begin DoDot:2
+16 KILL @REFM@(CATNA)
+17 SET CATCNT=CATCNT+1
+18 WRITE !!,DIACNT_". Dialog- GEC REFERRAL "_$PIECE(DIASYN," ",2,4)
+19 WRITE !!,CATCNT_". Category- ",CATNA
+20 WRITE !," Synonum- "_DIASYN
+21 WRITE !!," Health Factors---"
+22 SET FNA=""
FOR
SET FNA=$ORDER(@REF@(DIASYN,CATNA,FNA))
if FNA=""
QUIT
Begin DoDot:3
+23 SET FACCNT=FACCNT+1
+24 SET VAL=$ORDER(@REF@(DIASYN,CATNA,FNA,-1))
+25 SET IEN=$ORDER(@REF@(DIASYN,CATNA,FNA,VAL,0))
+26 SET STOP=$ORDER(@REF@(DIASYN,CATNA,FNA,VAL,IEN,-1))
+27 IF STOP=0
SET STOPCNT=STOPCNT+1
+28 SET STOPNA=$SELECT(STOP=0:"(((NOT IN USE)))",1:"")
+29 SET VO=0
+30 IF STOPNA'=""
SET VO=1
+31 WRITE !,FACCNT_". "
IF VO
WRITE IORVON
+32 WRITE FNA," ",STOPNA,IORVOFF
IF $LENGTH(FNA)>40
WRITE " ",IORVON,$LENGTH(FNA),IORVOFF
+33 WRITE !,?19,$SELECT('$DATA(@REFM@(FNA,IEN)):IORVON,1:""),"ien- "_IEN," (",$ORDER(@REFM@(FNA,0))_")",IORVOFF
IF '$DATA(@REFM@(FNA))
WRITE !
+34 WRITE ?17,IORVON,$SELECT($DATA(@REFM@(FNA)):"",1:"**NOT Originally Released Name")
WRITE IORVOFF
KILL @REFM@(FNA)
+35 SET SYN=$PIECE($GET(^AUTTHF($ORDER(^AUTTHF("B",FNA,0)),0)),"^",9)
+36 SET TERM=$ORDER(^PXRMD(811.5,"AF",IEN_";AUTTHF(",0))
+37 WRITE !,?18,$SELECT(TERM="":IORVON,1:""),"Term- ",$SELECT(TERM="":"NO TERM",1:$PIECE($GET(^PXRMD(811.5,TERM,0)),"^",1)),IORVOFF
+38 IF SYN=""
WRITE !,?17,IORVON,$SELECT(SYN="":"**Synonum Missing",1:"syn- "_SYN),IORVOFF
+39 IF '$TEST
WRITE !,?19,$SELECT(SYN="":"**Synonum Missing",1:"syn- "_SYN)
+40 WRITE !,?19,"val- "_VAL,!
+41 WRITE IORVOFF
End DoDot:3
End DoDot:2
End DoDot:1
+42 IF $DATA(@REFM)
WRITE !!,?7,"**Missing Original GEC Health Factors**"
+43 IF $DATA(@REFM)
SET FNA=""
FOR
SET FNA=$ORDER(@REFM@(FNA))
if FNA=""
QUIT
Begin DoDot:1
+44 WRITE !,?10,FNA
End DoDot:1
+45 WRITE !
+46 WRITE !,"Categories - "_$JUSTIFY(CATCNT,3)
+47 WRITE !,"Health Factors- "_$JUSTIFY(FACCNT,3)
+48 WRITE !,"Not in Use - "_$JUSTIFY(STOPCNT,3)
+49 WRITE !,"Used Factors - ",$JUSTIFY(((FACCNT+CATCNT)-STOPCNT),3)
+50 WRITE !
+51 WRITE !,"-----------------------------END OF REPORT ----------------------"
+52 KILL ^TMP("PXRMGEC",$JOB,"MAN"),^TMP("PXRMGEC",$JOB,"MAN1"),HFDIA
+53 KILL ^TMP("PXRMGEC",$JOB,"MATCH")
+54 DO KILL^%ZISS
+55 QUIT
+56 ;
+57 ;
+58 ;
PR1 SET REF="^TMP(""PXRMGEC"",$J,""MAN1"")"
+1 SET X="IOINHI;IOINLOW;IORVON;IORVOFF"
+2 DO ENDR^%ZISS
+3 DO DAS
DO MATCHB^PXRMGECY
DO MATCHB^PXRMGECZ
+4 NEW DIACNT,CATCNT,FACCNT,IEN,VAL,STOPCNT,XCNT
+5 SET (DIACNT,CATCNT,FACCNT,STOPCNT)=0
+6 DO HF
+7 ;
DISPLAY ;REPORT DISPLAY
+1 ;
+2 SET DIASYN=""
FOR
SET DIASYN=$ORDER(@REF@(DIASYN))
if DIASYN=""
QUIT
Begin DoDot:1
+3 SET DIACNT=DIACNT+1
SET CATCNT=0
+4 WRITE !!,DIACNT," Dialog- "_$PIECE($GET(^PXRMD(801.41,$ORDER(^PXRMD(801.41,"AC",DIASYN,"")),0)),"^",1)
+5 SET CATNA=""
FOR
SET CATNA=$ORDER(@REF@(DIASYN,CATNA))
if CATNA=""
QUIT
Begin DoDot:2
+6 SET CATCNT=CATCNT+1
+7 WRITE !!,?2,CATCNT_". Category- ",CATNA
+8 WRITE !,?7," Ref# (score) Health Factors---"
+9 NEW FNACNT
SET FNACNT=0
+10 SET FNA=""
FOR
SET FNA=$ORDER(@REF@(DIASYN,CATNA,FNA))
if FNA=""
QUIT
Begin DoDot:3
+11 SET XCNT=FACCNT
SET FACCNT=FACCNT+1
SET FNACNT=FNACNT+1
+12 SET VAL=$ORDER(@REF@(DIASYN,CATNA,FNA,-1))
+13 SET IEN=$ORDER(@REF@(DIASYN,CATNA,FNA,VAL,0))
+14 SET STOP=$ORDER(@REF@(DIASYN,CATNA,FNA,VAL,IEN,-1))
+15 IF STOP=0
SET FACCNT=XCNT
+16 IF STOP=0
SET STOPCNT=STOPCNT+1
QUIT
+17 SET STOPNA=$SELECT(STOP=0:"(((NOT IN USE)))",1:"")
+18 NEW COMB
SET COMB=DIACNT_"."_CATCNT_"."_FNACNT_" ("_VAL_")"
+19 SET VO=0
+20 IF STOPNA'=""
SET VO=1
+21 WRITE !," "
IF VO
WRITE IORVON
+22 WRITE ?11,COMB," "_FNA," ",STOPNA,IORVOFF
WRITE " "
+23 ;==================================================
+24 WRITE IORVOFF
End DoDot:3
End DoDot:2
End DoDot:1
+25 WRITE !!,"Health Factors- "_$JUSTIFY(FACCNT,3)
+26 WRITE !
+27 WRITE !,"-----------------------------END OF REPORT ----------------------"
+28 KILL ^TMP("PXRMGEC",$JOB,"MAN"),^TMP("PXRMGEC",$JOB,"MAN1"),HFDIA
+29 KILL ^TMP("PXRMGEC",$JOB,"MATCH")
+30 DO KILL^%ZISS
+31 QUIT
+32 ;
