- DGSEC2 ;ALB/RMO - Display User Access to Patient Record ; 22 JUN 87 1:00 pm
- ;;5.3;Registration;**391,1013,1015**;Aug 13, 1993;Build 21
- ;IHS/ANMC/LJF 9/01/2000 added call to list template
- ; 1/04/2002 removed screen on lookup
- ;
- ;ihs/cmi/maw 05/10/2011 PATCH 1013 RQMT 158 changed width of record to accomodate more option used text
- ;
- I '$D(^XUSEC("DG SECURITY OFFICER",DUZ)) W !!?3,*7,"You do not have the appropriate access privileges to display user access." Q
- S DIC("A")="Select PATIENT NAME: ",DIC="^DGSL(38.1,",DIC(0)="AEMQ"
- ;
- ;IHS/ANMC/LJF 1/04/2002 removed screen
- ;S DIC("S")="I (+$P(^(0),U,2))!(+$O(^(""D"",0)))",DGSENFLG=""
- S DGSENFLG=""
- ;IHS/ANMC/LJF 1/04/2002 end of mod
- ;
- W ! D ^DIC K DIC("A"),DIC("S"),DGSENFLG
- G Q:Y<0 S DFN=+Y D DTRNG G Q:DGPOP
- ;
- ASKUSR K DGUSR W !!,"Do you want to see when a select user accessed this record" S %=2 D YN^DICN G Q:%<0 S:%=2 DGUSR="ALL" I '% W !!,"Enter 'YES' to display a select user, or 'NO' to display all users." G ASKUSR
- I '$D(DGUSR) S DIC="^VA(200,",DIC(0)="AEMQ" W ! D ^DIC G Q:Y<0 S DGUSR=+Y
- ;S DGPGM="START^DGSEC2",DGVAR="DFN^DGBEGDT^DGENDDT^DGRNG1^DGRNG2^DGUSR" W ! D ZIS^DGUTQ G Q:POP ;IHS/ANMC/LJF 9/1/2000
- S DGPGM="^BDGSEC2",DGVAR="DFN^DGBEGDT^DGENDDT^DGRNG1^DGRNG2^DGUSR" W ! D ZIS^DGUTQ G Q:POP D ^BDGSEC2 Q ;IHS/ANMC/LJF 9/1/2000
- ;
- START U IO S DGX="",(DGCNT,DGPGE)=0 S:$D(^DPT(DFN,0)) DGNAM=$E($P(^(0),"^",1),1,30),DOB=$P(^(0),"^",3),SSN=$P(^(0),"^",9) D SELUSR:DGUSR,ALLUSR:DGUSR="ALL"
- ;
- Q ;IHS/ANMC/LJF 9/1/2000 Line Q called by BDGSEC2
- Q K DFN,DGBEGDT,DGCNT,DGDTE,DGENDDT,DGLNE,DGNAM,DGPGE,DGPOP,DGPGM,DGRNG1,DGRNG2,DGSL0,DGVAR,DGX,POP D CLOSE^DGUTQ
- Q
- ;
- SELUSR D CHKDTE I 'DGCNT W @IOF,!!?5,"User ",$S($D(^VA(200,DGUSR,0)):$P(^(0),"^"),1:DGUSR)," did not access the patient record of",!?5,DGNAM,$S(DGRNG1=DGRNG2:" on "_DGRNG1,1:" during "_DGRNG1_" and "_DGRNG2),"."
- Q
- ;
- ALLUSR F DGUSR=0:0 S DGUSR=$O(^DGSL(38.1,"AU",DFN,DGUSR)) Q:'DGUSR!(DGX="^") D CHKDTE
- I 'DGCNT W @IOF,!!?5,"No user access logged for the patient record of ",DGNAM,!?5,$S(DGRNG1=DGRNG2:"on "_DGRNG1,1:"during "_DGRNG1_" and "_DGRNG2),"."
- Q
- ;
- CHKDTE ;F DGDTE=DGENDDT:0 S DGDTE=$O(^DGSL(38.1,"AU",DFN,DGUSR,DGDTE)) Q:'DGDTE!(DGBEGDT<DGDTE) I $D(^DGSL(38.1,DFN,"D",DGDTE,0)) S DGSL0=^(0),DGCNT=DGCNT+1 D HD:'DGPGE!(($Y+4)>IOSL) Q:DGX="^" D PRT
- F DGDTE=DGENDDT:0 S DGDTE=$O(^DGSL(38.1,"AU",DFN,DGUSR,DGDTE)) Q:'DGDTE!(DGBEGDT<DGDTE) I $D(^DGSL(38.1,DFN,"D",DGDTE,0)) S DGSL0=^(0),DGCNT=DGCNT+1 D PRT ;IHS/ANMC/LJF 9/1/2000 HD called in BDGSEC2 instead
- Q
- ;
- PRT W !,$S($D(^VA(200,DGUSR,0)):$E($P(^(0),"^"),1,20),1:"Unknown") S Y=$P(DGSL0,"^") W ?23 D DT^DIQ
- W ?46,$S($P(DGSL0,"^",3)]"":$E($P(DGSL0,"^",3),1,65),1:"Unknown"),?113,$P($P(^DD(38.11,4,0),$P(DGSL0,"^",4)_":",2),";",1)
- Q
- ;
- HD D CRCHK Q:DGX="^" W @IOF,!,"Sensitive Patient Access Report for ",DGRNG1," to ",DGRNG2 S DGPGE=DGPGE+1 W ?70,"Page: ",DGPGE
- K DGLNE S $P(DGLNE,"=",80)="" W !,DGLNE,!,"Run Date : " D H^DGUTL S Y=DGTIME W ?14 D DT^DIQ W ?47,"Social Sec Num: ",$S($D(SSN):SSN,1:"Unknown")
- W !,"Patient Name: ",$S($D(DGNAM):DGNAM,1:"Unknown"),?47,"Date of Birth : " S Y=$S($D(DOB):DOB,1:"Unknown") D DT^DIQ W !,DGLNE
- K DGLNE S $P(DGLNE,"-",80)="" W !!,"USER",?23,"DATE ACCESSED",?46,"OPTION/PROTOCOL USED",?70,"INPATIENT",!,DGLNE
- Q
- ;
- CRCHK I DGPGE,$E(IOST,1)="C" W !!,*7,"Press RETURN to continue or '^' to stop " R X:DTIME S DGX=X
- Q
- ;
- DTRNG S DGPOP=0 K DGBEGDT,DGENDDT,DGRNG1,DGRNG2 W !!,"**** Date Range Selection ****"
- BEGDT W ! S %DT="APEX",%DT("A")=" Beginning DATE : " D ^%DT I Y<0 S DGPOP=1 K %DT Q
- I $D(DGSDFLG),Y>$P(DGSDFLG,"^",2) W *7," ??" G BEGDT
- S %DT(0)=Y,DGBEGDT=9999999.9999-(Y-.0001) X ^DD("DD") S DGRNG1=Y
- ENDDT W ! S %DT="APEX",%DT("A")=" Ending DATE : " D ^%DT I Y<0 S DGPOP=1 K %DT Q
- I $D(DGSDFLG),Y>$P(DGSDFLG,"^",2) W *7," ??" G ENDDT
- S DGENDDT=9999999.9999-(Y+.9999) X ^DD("DD") S DGRNG2=Y W ! K %DT Q
- DGSEC2 ;ALB/RMO - Display User Access to Patient Record ; 22 JUN 87 1:00 pm
- +1 ;;5.3;Registration;**391,1013,1015**;Aug 13, 1993;Build 21
- +2 ;IHS/ANMC/LJF 9/01/2000 added call to list template
- +3 ; 1/04/2002 removed screen on lookup
- +4 ;
- +5 ;ihs/cmi/maw 05/10/2011 PATCH 1013 RQMT 158 changed width of record to accomodate more option used text
- +6 ;
- +7 IF '$DATA(^XUSEC("DG SECURITY OFFICER",DUZ))
- WRITE !!?3,*7,"You do not have the appropriate access privileges to display user access."
- QUIT
- +8 SET DIC("A")="Select PATIENT NAME: "
- SET DIC="^DGSL(38.1,"
- SET DIC(0)="AEMQ"
- +9 ;
- +10 ;IHS/ANMC/LJF 1/04/2002 removed screen
- +11 ;S DIC("S")="I (+$P(^(0),U,2))!(+$O(^(""D"",0)))",DGSENFLG=""
- +12 SET DGSENFLG=""
- +13 ;IHS/ANMC/LJF 1/04/2002 end of mod
- +14 ;
- +15 WRITE !
- DO ^DIC
- KILL DIC("A"),DIC("S"),DGSENFLG
- +16 IF Y<0
- GOTO Q
- SET DFN=+Y
- DO DTRNG
- IF DGPOP
- GOTO Q
- +17 ;
- ASKUSR KILL DGUSR
- WRITE !!,"Do you want to see when a select user accessed this record"
- SET %=2
- DO YN^DICN
- IF %<0
- GOTO Q
- IF %=2
- SET DGUSR="ALL"
- IF '%
- WRITE !!,"Enter 'YES' to display a select user, or 'NO' to display all users."
- GOTO ASKUSR
- +1 IF '$DATA(DGUSR)
- SET DIC="^VA(200,"
- SET DIC(0)="AEMQ"
- WRITE !
- DO ^DIC
- IF Y<0
- GOTO Q
- SET DGUSR=+Y
- +2 ;S DGPGM="START^DGSEC2",DGVAR="DFN^DGBEGDT^DGENDDT^DGRNG1^DGRNG2^DGUSR" W ! D ZIS^DGUTQ G Q:POP ;IHS/ANMC/LJF 9/1/2000
- +3 ;IHS/ANMC/LJF 9/1/2000
- SET DGPGM="^BDGSEC2"
- SET DGVAR="DFN^DGBEGDT^DGENDDT^DGRNG1^DGRNG2^DGUSR"
- WRITE !
- DO ZIS^DGUTQ
- IF POP
- GOTO Q
- DO ^BDGSEC2
- QUIT
- +4 ;
- START USE IO
- SET DGX=""
- SET (DGCNT,DGPGE)=0
- IF $DATA(^DPT(DFN,0))
- SET DGNAM=$EXTRACT($PIECE(^(0),"^",1),1,30)
- SET DOB=$PIECE(^(0),"^",3)
- SET SSN=$PIECE(^(0),"^",9)
- IF DGUSR
- DO SELUSR
- IF DGUSR="ALL"
- DO ALLUSR
- +1 ;
- +2 ;IHS/ANMC/LJF 9/1/2000 Line Q called by BDGSEC2
- QUIT
- Q KILL DFN,DGBEGDT,DGCNT,DGDTE,DGENDDT,DGLNE,DGNAM,DGPGE,DGPOP,DGPGM,DGRNG1,DGRNG2,DGSL0,DGVAR,DGX,POP
- DO CLOSE^DGUTQ
- +1 QUIT
- +2 ;
- SELUSR DO CHKDTE
- IF 'DGCNT
- WRITE @IOF,!!?5,"User ",$SELECT($DATA(^VA(200,DGUSR,0)):$PIECE(^(0),"^"),1:DGUSR)," did not access the patient record of",!?5,DGNAM,$SELECT(DGRNG1=DGRNG2:" on "_DGRNG1,1:" during "_DGRNG1_" and "_DGRNG2),"."
- +1 QUIT
- +2 ;
- ALLUSR FOR DGUSR=0:0
- SET DGUSR=$ORDER(^DGSL(38.1,"AU",DFN,DGUSR))
- IF 'DGUSR!(DGX="^")
- QUIT
- DO CHKDTE
- +1 IF 'DGCNT
- WRITE @IOF,!!?5,"No user access logged for the patient record of ",DGNAM,!?5,$SELECT(DGRNG1=DGRNG2:"on "_DGRNG1,1:"during "_DGRNG1_" and "_DGRNG2),"."
- +2 QUIT
- +3 ;
- CHKDTE ;F DGDTE=DGENDDT:0 S DGDTE=$O(^DGSL(38.1,"AU",DFN,DGUSR,DGDTE)) Q:'DGDTE!(DGBEGDT<DGDTE) I $D(^DGSL(38.1,DFN,"D",DGDTE,0)) S DGSL0=^(0),DGCNT=DGCNT+1 D HD:'DGPGE!(($Y+4)>IOSL) Q:DGX="^" D PRT
- +1 ;IHS/ANMC/LJF 9/1/2000 HD called in BDGSEC2 instead
- FOR DGDTE=DGENDDT:0
- SET DGDTE=$ORDER(^DGSL(38.1,"AU",DFN,DGUSR,DGDTE))
- IF 'DGDTE!(DGBEGDT<DGDTE)
- QUIT
- IF $DATA(^DGSL(38.1,DFN,"D",DGDTE,0))
- SET DGSL0=^(0)
- SET DGCNT=DGCNT+1
- DO PRT
- +2 QUIT
- +3 ;
- PRT WRITE !,$SELECT($DATA(^VA(200,DGUSR,0)):$EXTRACT($PIECE(^(0),"^"),1,20),1:"Unknown")
- SET Y=$PIECE(DGSL0,"^")
- WRITE ?23
- DO DT^DIQ
- +1 WRITE ?46,$SELECT($PIECE(DGSL0,"^",3)]"":$EXTRACT($PIECE(DGSL0,"^",3),1,65),1:"Unknown"),?113,$PIECE($PIECE(^DD(38.11,4,0),$PIECE(DGSL0,"^",4)_":",2),";",1)
- +2 QUIT
- +3 ;
- HD DO CRCHK
- IF DGX="^"
- QUIT
- WRITE @IOF,!,"Sensitive Patient Access Report for ",DGRNG1," to ",DGRNG2
- SET DGPGE=DGPGE+1
- WRITE ?70,"Page: ",DGPGE
- +1 KILL DGLNE
- SET $PIECE(DGLNE,"=",80)=""
- WRITE !,DGLNE,!,"Run Date : "
- DO H^DGUTL
- SET Y=DGTIME
- WRITE ?14
- DO DT^DIQ
- WRITE ?47,"Social Sec Num: ",$SELECT($DATA(SSN):SSN,1:"Unknown")
- +2 WRITE !,"Patient Name: ",$SELECT($DATA(DGNAM):DGNAM,1:"Unknown"),?47,"Date of Birth : "
- SET Y=$SELECT($DATA(DOB):DOB,1:"Unknown")
- DO DT^DIQ
- WRITE !,DGLNE
- +3 KILL DGLNE
- SET $PIECE(DGLNE,"-",80)=""
- WRITE !!,"USER",?23,"DATE ACCESSED",?46,"OPTION/PROTOCOL USED",?70,"INPATIENT",!,DGLNE
- +4 QUIT
- +5 ;
- CRCHK IF DGPGE
- IF $EXTRACT(IOST,1)="C"
- WRITE !!,*7,"Press RETURN to continue or '^' to stop "
- READ X:DTIME
- SET DGX=X
- +1 QUIT
- +2 ;
- DTRNG SET DGPOP=0
- KILL DGBEGDT,DGENDDT,DGRNG1,DGRNG2
- WRITE !!,"**** Date Range Selection ****"
- BEGDT WRITE !
- SET %DT="APEX"
- SET %DT("A")=" Beginning DATE : "
- DO ^%DT
- IF Y<0
- SET DGPOP=1
- KILL %DT
- QUIT
- +1 IF $DATA(DGSDFLG)
- IF Y>$PIECE(DGSDFLG,"^",2)
- WRITE *7," ??"
- GOTO BEGDT
- +2 SET %DT(0)=Y
- SET DGBEGDT=9999999.9999-(Y-.0001)
- XECUTE ^DD("DD")
- SET DGRNG1=Y
- ENDDT WRITE !
- SET %DT="APEX"
- SET %DT("A")=" Ending DATE : "
- DO ^%DT
- IF Y<0
- SET DGPOP=1
- KILL %DT
- QUIT
- +1 IF $DATA(DGSDFLG)
- IF Y>$PIECE(DGSDFLG,"^",2)
- WRITE *7," ??"
- GOTO ENDDT
- +2 SET DGENDDT=9999999.9999-(Y+.9999)
- XECUTE ^DD("DD")
- SET DGRNG2=Y
- WRITE !
- KILL %DT
- QUIT
