Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUPSCLR

XUPSCLR.m

Go to the documentation of this file.
  1. XUPSCLR ;OIFO-CS/GRR/RAM/DW/PN - New Person file Cleanup Report ; 1 Jan 2004
  1. ;;8.0;KERNEL;**309**; Jul 10, 1995
  1. ;
  1. Q
  1. ;
  1. DETAIL ; -- detailed report
  1. ;
  1. N TYPE
  1. ;
  1. S TYPE="Detail Report of"
  1. ;
  1. D EN
  1. ;
  1. Q
  1. ;
  1. STATS ; -- totals only
  1. ;
  1. N TYPE
  1. ;
  1. S TYPE="Statistical Report of"
  1. ;
  1. D EN
  1. ;
  1. Q
  1. ;
  1. EN ; -- entry point
  1. ;
  1. N ZTDESC,ZTSAVE,ZTIO,ZTDTH,X,ZTQUEUED,ZTREQ,ZTRTN,DIR,POP,Y
  1. ;
  1. W !!,"This option will print "_TYPE
  1. W " entries missing SEX, DOB, or SSN",!
  1. W "data in the New Person file (#200)",!
  1. ;
  1. S DIR(0)="YA",DIR("B")="Yes",DIR("A")="Do you wish to continue? "
  1. S DIR("?")="Enter 'Yes' to continue or 'No' to quit"
  1. D ^DIR K DIR ;ask user if they want to continue with option
  1. Q:'Y!($D(DIRUT)) ;user responded No or with '^' to exit
  1. ;
  1. ;initialize task variables
  1. S ZTDESC="New Person file Cleanup report"
  1. S ZTRTN="EN1^XUPSCLR"
  1. S ZTSAVE("TYPE")=TYPE
  1. ;
  1. I TYPE="Detail Report of" D
  1. . W !!,"The report may be lengthy. "
  1. . W "It is suggested to queue the report."
  1. D ZIS^XUPSUTQ ;does device selection and queueing if selected
  1. Q:POP ;quit if task was queued
  1. ;
  1. EN1 ;
  1. ;
  1. N ACTIVE,DIR,DIRUT,DOB,SSN,FLG,I,IEN,MISS,MISSING,NODE,Y,PHONE
  1. N NAME,PERSON,POP,SEX,TOTAL,VISITOR,X,XUPSDT,XUPSL,XUPSREC
  1. ;
  1. D INIT
  1. ;
  1. S IEN=.9
  1. F S IEN=$O(^VA(200,IEN)) Q:'IEN D XXX
  1. ;
  1. I $E(TYPE,1)="D" D ZZZ Q:FLG
  1. ;
  1. D TOTALS
  1. ;
  1. W:PERSON @IOF
  1. ;
  1. D ^%ZISC
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. ;
  1. Q
  1. ;
  1. ;
  1. ; pause and wait for user reponse before displaying next screen
  1. I $E(IOST,1,2)="C-",NAME'="" D Q:FLG
  1. .W !
  1. .S DIR(0)="E" D ^DIR S FLG='Y
  1. ;
  1. ;if terminal clear screen first time
  1. I $E(IOST,1,2)="C-",NAME="" W @IOF
  1. ;
  1. ;if printer do not form feed before printing first page
  1. I NAME'="" W @IOF
  1. ;
  1. W !,?1,"New Person file Assessment Report - "
  1. W XUPSREC_" Persons",?55,XUPSDT
  1. W !,?1,"Person Name",?31,"IEN",?40,"Missing",?48,"Missing"
  1. W ?56,"Missing",?65,"Office Phone",!,?42,"SEX",?50,"DOB",?58,"SSN",!
  1. ;
  1. Q
  1. ;
  1. TOTALS ;
  1. ;if terminal pause after full screen
  1. I $E(TYPE,1)="D",$E(IOST)="C" D Q:FLG
  1. .S DIR(0)="E" D ^DIR
  1. .S:'Y FLG=1
  1. ;
  1. W @IOF
  1. ;W !,"NOTE: Visitor entries not included in totals other "
  1. ;W "than the Visitor total!",!
  1. ;
  1. S XUPSL="Total Entries: " W !,?(50-$L(XUPSL)),XUPSL,$J(PERSON,6,0)
  1. S XUPSL="Total Visitor Entries: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(VISITOR,6,0)
  1. S XUPSL="(Visitor entries not included in the following counts)"
  1. W !!,?(50-$L(XUPSL)),XUPSL
  1. S XUPSL="Total Non-Visitor Entries: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(PERSON-VISITOR,6,0)
  1. S XUPSL="Total Entries Missing Sex Code: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(MISSING("SEX"),6,0)
  1. S XUPSL="Total Entries Missing DOB: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(MISSING("DOB"),6,0)
  1. S XUPSL="Total Entries Missing SSN: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(MISSING("SSN"),6,0)
  1. S XUPSL="Total Entries Missing One Data Element: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(MISS(1),6,0)
  1. S XUPSL="Total Entries Missing Two Data Elements: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(MISS(2),6,0)
  1. S XUPSL="Total Entries Missing Three Data Elements: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(MISS(3),6,0)
  1. S XUPSL="Total Entries Missing Data: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(TOTAL("MISSING"),6,0)
  1. S XUPSL="Total Active Entries: "
  1. W !!,?(50-$L(XUPSL)),XUPSL,$J(ACTIVE("TOTAL"),6,0)
  1. S XUPSL="Total Active Entries Missing Data: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(ACTIVE("MISSING"),6,0)
  1. S XUPSL="Total Active Entries Missing Sex Code: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(ACTIVE("SEX"),6,0)
  1. S XUPSL="Total Active Entries Missing DOB: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(ACTIVE("DOB"),6,0)
  1. S XUPSL="Total Active Entries Missing SSN: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(ACTIVE("SSN"),6,0)
  1. S XUPSL="Total Active Entries Missing One Data Elements: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(ACTIVE(1),6,0)
  1. S XUPSL="Total Active entries Missing Two Data Elements: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(ACTIVE(2),6,0)
  1. S XUPSL="Total Active Entries Missing Three Data Elements: "
  1. W !,?(50-$L(XUPSL)),XUPSL,$J(ACTIVE(3),6,0)
  1. ;
  1. ;pause before clearing screen if terminal
  1. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR
  1. ;
  1. Q
  1. ;
  1. XXX ;
  1. S PERSON=PERSON+1 ;count IEN
  1. ;
  1. ; count visitors - quit if visitor
  1. I '$$ACTIVE^XUSER(IEN),$D(^VA(200,IEN,8910)) D Q
  1. .S VISITOR=VISITOR+1
  1. ;
  1. ; count active
  1. I $$ACTIVE^XUSER(IEN) D
  1. .S ACTIVE("TOTAL")=ACTIVE("TOTAL")+1,XUPSREC="Active"
  1. ;
  1. ; not active user
  1. I '$$ACTIVE^XUSER(IEN) S XUPSREC="Inactive"
  1. ;
  1. S (SEX,DOB,SSN)="" ;initialize missing data designator
  1. S MISSING=0 ;initialize total missing for this entry
  1. S NODE=$G(^VA(200,IEN,1)) ;get node where data is stored
  1. ;
  1. I $P(NODE,"^",2)="" D ;sex is missing
  1. .S SEX="X" ;flag as missing on report
  1. .S MISSING("SEX")=MISSING("SEX")+1 ;add 1 to missing sex count
  1. .S MISSING=MISSING+1 ;add 1 to missing data this entry count
  1. .S:$$ACTIVE^XUSER(IEN) ACTIVE("SEX")=ACTIVE("SEX")+1
  1. ;
  1. I $P(NODE,"^",3)="" D ;dob is missing
  1. .S DOB="X" ;flag as missing on report
  1. .S MISSING("DOB")=MISSING("DOB")+1 ;add 1 to missing dob count
  1. .S MISSING=MISSING+1 ;add 1 to missing data this entry count
  1. .S:$$ACTIVE^XUSER(IEN) ACTIVE("DOB")=ACTIVE("DOB")+1
  1. ;
  1. I $P(NODE,"^",9)="" D ;ssn missing
  1. .S SSN="X" ;flag as missing on report
  1. .S MISSING("SSN")=MISSING("SSN")+1 ;add 1 to missing ssn count
  1. .S MISSING=MISSING+1 ;add 1 to missing count this entry
  1. .S:$$ACTIVE^XUSER(IEN) ACTIVE("SSN")=ACTIVE("SSN")+1
  1. ;
  1. Q:'MISSING ;entry not missing any data, nothing to print
  1. ;
  1. S TOTAL("MISSING")=TOTAL("MISSING")+1
  1. ;
  1. I $$ACTIVE^XUSER(IEN) S ACTIVE("MISSING")=ACTIVE("MISSING")+1
  1. ;
  1. I $$ACTIVE^XUSER(IEN) D
  1. .S ACTIVE(MISSING)=ACTIVE(MISSING)+1
  1. ;
  1. S MISS(MISSING)=MISS(MISSING)+1
  1. ;
  1. I $E(TYPE,1)="D" D
  1. .N X
  1. .S PHONE=$P($G(^VA(200,IEN,.13)),"^",2)
  1. .S X=PHONE_"^"_SEX_"^"_DOB_"^"_SSN
  1. . I $P($G(^VA(200,IEN,0)),"^",1)="" Q
  1. .S ^TMP($J,XUPSREC,$P(^VA(200,IEN,0),"^",1),IEN)=X
  1. ;
  1. Q
  1. ;
  1. INIT ; -- initialize
  1. ;
  1. K ^TMP($J)
  1. ;
  1. S (ACTIVE("MISSING"),ACTIVE("TOTAL"),TOTAL("MISSING"))=0
  1. S (PERSON,VISITOR,FLG,ACTIVE)=0
  1. ;
  1. F I=1:1:3 S (MISS(I),ACTIVE(I))=0
  1. F I="SEX","DOB","SSN" S (ACTIVE(I),MISSING(I))=0
  1. ;
  1. ;get current date/time reformat to external form for header
  1. N %,%I,%H D NOW^%DTC S Y=% D DD^%DT S XUPSDT=Y
  1. ;
  1. Q
  1. ;
  1. ZZZ ; -- detailed output
  1. ;
  1. S XUPSREC="Active" D YYY Q:FLG
  1. I $E(IOST,1,2)="C-" D Q:FLG
  1. .W !
  1. .S DIR(0)="E" D ^DIR
  1. .S:'Y FLG=1
  1. I $E(IOST,1,2)'="C-" W @IOF
  1. ;
  1. S XUPSREC="Inactive" D YYY
  1. ;
  1. Q
  1. ;
  1. YYY ;
  1. S NAME=""
  1. ;
  1. D HEAD Q:FLG
  1. ;
  1. F S NAME=$O(^TMP($J,XUPSREC,NAME)) Q:NAME=""!(FLG) D
  1. .S IEN=0
  1. .F S IEN=$O(^TMP($J,XUPSREC,NAME,IEN)) Q:'IEN!(FLG) D
  1. ..S NODE=^TMP($J,XUPSREC,NAME,IEN)
  1. ..S PHONE=$P(NODE,"^",1)
  1. ..S SEX=$P(NODE,"^",2)
  1. ..S DOB=$P(NODE,"^",3)
  1. ..S SSN=$P(NODE,"^",4)
  1. ..W !,$P(^VA(200,IEN,0),"^",1)
  1. ..W ?31,IEN,?43,SEX
  1. ..W ?51,DOB,?59,SSN,?65,PHONE
  1. ..I $Y>(IOSL-6) D HEAD
  1. ;
  1. Q
  1. ;