- 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
- ;
- 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 ;
