source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANVAL.m@ 1318

QANVAL ;;HISC/GJC-Utilities for Incident Reporting ;4/26/91
 ;;2.0;Incident Reporting;**1,27**;08/07/1992
 ;
EN1 ;
 N QANBFLG,QANFFLG
 S (QANFLAG(0),QANOUT,QANXIT,QANAGN)=0,(QAN(0),QANBFLG,QANFFLG)=0
 W @IOF S QANIEN="" F QAN=0:0 S QANIEN=$O(^QA(742.4,"ACS",QANIEN)) Q:QANIEN=""  I "02"'[+QANIEN F QAN=0:0 S QAN=$O(^QA(742.4,"ACS",QANIEN,QAN)) Q:QAN'>0  S QAN(0)=QAN(0)+1
 I QAN(0)>0 W !!?12,$C(7),"There exist "_QAN(0)_" open INCIDENT CASE(S) on the system.",!!
 E  W !!?12,"There exists ZERO open INCIDENT CASE(S) on the system." K QAN,QANIEN
 I 'QANAGN F  W !!,"Do you wish to create a new incident event record" S %=2 D YN^DICN Q:"-112"[%  W !,$C(7),"Enter (Y)es, or (N)o, or ""^"" to quit."
 I 'QANAGN,%=-1 K QAN,QANIEN Q
 I 'QANAGN,%=1 S (QANFLAG(0),QANFFLG)=1,QANF="" D ^QANCDNT Q:QANXIT
 D:'QANFLAG(0) EDIT I QANXIT D CLEAN Q
 D:$D(QANDFN)&$D(QANIEN) EN2^QANUTL2
 F  W !!,"Do you wish to edit a particular open incident" S %=2 D YN^DICN Q:"-112"[%  W !!,"Enter (Y)es, (N)o, or ""^"" to exit"
 I %=1 S QANAGN=1 G EN1
 D CLEAN Q
CASE ;
 K DIC S DIC=742.4,DIC(0)="QEANZ",DIC("A")="Select Case Number: ",DIC("S")="I ""13""[+$P(^(0),U,8)",DIC("W")="D EN1^QANUTL" D ^DIC K DIC
 I +Y=-1 S QANXIT=1 W !!,$C(7),"Case Number not selected, exiting!!"
 E  S QANIEN=+Y
 Q
DATE ;
 K DIC,D S DIC="^QA(742.4,",DIC(0)="QEAMZ",DIC("A")="Select Date of Incident: ",D="BDT",DIC("S")="I ""13""[+$P(^(0),U,8)",DIC("W")="D EN1^QANUTL" D IX^DIC K DIC,D
 I +Y=-1 S QANXIT=1 W !!,$C(7),"Date of Incident not selected, exiting!!"
 E  S QANIEN=+Y
 Q
EDIT K DIR S DIR("A",1)="Would you like to: ",DIR("A",2)="1. Edit by the Case Number",DIR("A",3)="2. Edit by the Date of the Incident",DIR("A",4)="3. Edit by the Patient",DIR("A",5)="4. Edit by the Type of Incident"
 S DIR("A")="Enter a number: (1-4) ",DIR(0)="NOA^1:4:0",DIR("B")=3,DIR("?",1)="Choose the manner in which you wish to edit the record.",DIR("?")="Enter a number no less than 1, no greater than 4."
 D ^DIR K DIR
 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S QANXIT=1 Q
 S QANTYPE=+Y
 D @$S(QANTYPE=1:"CASE",QANTYPE=2:"DATE",QANTYPE=3:"PAT^QANUTL1",1:"TYPE")
 Q:$G(QANXIT)
 I $G(QANBFLG)'=1 L +^QA(742.4,QANIEN):5 I '$T W !!?16,$C(7),"Another person is editing this Incident Report." S QANXIT=1
 Q:QANXIT  D:$G(QANTYPE)'=3 PAT0^QANUTL1
 Q
TYPE ;
 K DIC,D S DIC="^QA(742.4,",DIC(0)="QEAMZ",DIC("A")="Select Type of Incident: ",DIC("S")="I ""13""[+$P(^(0),U,8)",D="BINC",DIC("W")="D EN1^QANUTL" D IX^DIC K DIC,D
 I +Y=-1 S QANXIT=1 W !!,$C(7),"Type of Incident not selected, exiting!!"
 E  S QANIEN=+Y
 Q
PATMAN ;DELETING A PATIENT'S RECORD
 ;***********************************************************************
 ;*** NOTE: Execution of this subroutine deletes the "ACN" x-ref from ***
 ;*** the global ^QA(742.4!                                           ***
 ;***********************************************************************
 K DIC S (DIC,DIE)="^QA(742,",DIC(0)="QEAMZ",DIC("A")="Select Patient: "
 S DIC("S")="I $D(^QA(742,""BPRS"",1,+Y))"
 S DIC("W")="D DICW^QANUTL1",QANXX=1,D="B^BS5"
 D MIX^DIC1 K DIC S QANPAT=+Y
 I QANPAT'>0 G K9
 S QANINCD=+$O(^QA(742.4,"ACN",QANPAT,"")) G:QANINCD'>0 K9
 I $O(^QA(742,"BCS",QANINCD,""))=QANPAT,$O(^QA(742,"BCS",QANINCD,QANPAT))']"" D WARN^QANAUX1 G K9
 S DIE="^QA(742,",DR=".13R",DA=QANPAT D ^DIE S QANPTST=+$P(^QA(742,QANPAT,0),U,12)
 K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANPAT,QAUDIT("ACTION")=$S(QANPTST=1:"o",QANPTST=-1:"d",1:"c"),QAUDIT("COMMENT")=$S(QANPTST=1:"Open ",QANPTST=-1:"Delete ",1:"Close ")_"a patient record" D ^QAQAUDIT
K9 K %W,%X,%Y,C,D0,DA,DIE,DISYS,DR,QAN,QANINCD,QANPAT,QANSSN,QANST,QANXX,X
 K QANPTST,QAUDIT,Y
 Q
CLEAN ;Kill and quit.
 K C,D,DIC,D0,DA,MSSG0,MSSG1,MSSG2,QAN,QANADM,QANADMDT,QANAFRM,QANAME
 K QANCHK,QANCODE,QANDFN,QANDGPM,QANDT,QANDUZ,QANF,QANFLAG,QANHOME
 K QANINC,QANIEN,QANINCR,QANINPAT,QANINV,QANMAIL,QANMIEN,QANOUT,QANPLC
 K X,X1,X2,QANPID,QANPIEN,QANSITE,QANSSN,QANST,QANST1,QANTRSP,QANWARD
 K QANXIT,QANZERO,QANPAT,QANTYPE,QANX,QANZER0,QANTTL,QANSERV,QANPSDO
 K QANDOB,QANHOLD,^UTILITY($J),QANDOB,QANAGE,QANQAN,QANAGN,QANYN,POP
 K QANEOP,QANHEAD,QANINS,QANLINE,QANRSP0,QANRSP1,QANSTAT,QANPAGE,QANCS
 K QANDED,VAIN,VAERR,QANIRIN,QANLCTN,QANGLB0,QAUDIT,DTOUT,DUOUT,DIROUT
 K %,%T,%W,%X,%Y,DI,DIR,DQ,J,QANIC,QANPT,QANYN,QANPT0,Y,DIRUT,%DT,DIE,DR
 K QANPRS,QAHDNM,QAHDSSN,QAHOLD
 Q