source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANVAL.m@ 700

Last change on this file since 700 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1QANVAL ;;HISC/GJC-Utilities for Incident Reporting ;4/26/91
2 ;;2.0;Incident Reporting;**1,27**;08/07/1992
3 ;
4EN1 ;
5 N QANBFLG,QANFFLG
6 S (QANFLAG(0),QANOUT,QANXIT,QANAGN)=0,(QAN(0),QANBFLG,QANFFLG)=0
7 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
8 I QAN(0)>0 W !!?12,$C(7),"There exist "_QAN(0)_" open INCIDENT CASE(S) on the system.",!!
9 E W !!?12,"There exists ZERO open INCIDENT CASE(S) on the system." K QAN,QANIEN
10 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."
11 I 'QANAGN,%=-1 K QAN,QANIEN Q
12 I 'QANAGN,%=1 S (QANFLAG(0),QANFFLG)=1,QANF="" D ^QANCDNT Q:QANXIT
13 D:'QANFLAG(0) EDIT I QANXIT D CLEAN Q
14 D:$D(QANDFN)&$D(QANIEN) EN2^QANUTL2
15 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"
16 I %=1 S QANAGN=1 G EN1
17 D CLEAN Q
18CASE ;
19 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
20 I +Y=-1 S QANXIT=1 W !!,$C(7),"Case Number not selected, exiting!!"
21 E S QANIEN=+Y
22 Q
23DATE ;
24 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
25 I +Y=-1 S QANXIT=1 W !!,$C(7),"Date of Incident not selected, exiting!!"
26 E S QANIEN=+Y
27 Q
28EDIT 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"
29 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."
30 D ^DIR K DIR
31 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S QANXIT=1 Q
32 S QANTYPE=+Y
33 D @$S(QANTYPE=1:"CASE",QANTYPE=2:"DATE",QANTYPE=3:"PAT^QANUTL1",1:"TYPE")
34 Q:$G(QANXIT)
35 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
36 Q:QANXIT D:$G(QANTYPE)'=3 PAT0^QANUTL1
37 Q
38TYPE ;
39 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
40 I +Y=-1 S QANXIT=1 W !!,$C(7),"Type of Incident not selected, exiting!!"
41 E S QANIEN=+Y
42 Q
43PATMAN ;DELETING A PATIENT'S RECORD
44 ;***********************************************************************
45 ;*** NOTE: Execution of this subroutine deletes the "ACN" x-ref from ***
46 ;*** the global ^QA(742.4! ***
47 ;***********************************************************************
48 K DIC S (DIC,DIE)="^QA(742,",DIC(0)="QEAMZ",DIC("A")="Select Patient: "
49 S DIC("S")="I $D(^QA(742,""BPRS"",1,+Y))"
50 S DIC("W")="D DICW^QANUTL1",QANXX=1,D="B^BS5"
51 D MIX^DIC1 K DIC S QANPAT=+Y
52 I QANPAT'>0 G K9
53 S QANINCD=+$O(^QA(742.4,"ACN",QANPAT,"")) G:QANINCD'>0 K9
54 I $O(^QA(742,"BCS",QANINCD,""))=QANPAT,$O(^QA(742,"BCS",QANINCD,QANPAT))']"" D WARN^QANAUX1 G K9
55 S DIE="^QA(742,",DR=".13R",DA=QANPAT D ^DIE S QANPTST=+$P(^QA(742,QANPAT,0),U,12)
56 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
57K9 K %W,%X,%Y,C,D0,DA,DIE,DISYS,DR,QAN,QANINCD,QANPAT,QANSSN,QANST,QANXX,X
58 K QANPTST,QAUDIT,Y
59 Q
60CLEAN ;Kill and quit.
61 K C,D,DIC,D0,DA,MSSG0,MSSG1,MSSG2,QAN,QANADM,QANADMDT,QANAFRM,QANAME
62 K QANCHK,QANCODE,QANDFN,QANDGPM,QANDT,QANDUZ,QANF,QANFLAG,QANHOME
63 K QANINC,QANIEN,QANINCR,QANINPAT,QANINV,QANMAIL,QANMIEN,QANOUT,QANPLC
64 K X,X1,X2,QANPID,QANPIEN,QANSITE,QANSSN,QANST,QANST1,QANTRSP,QANWARD
65 K QANXIT,QANZERO,QANPAT,QANTYPE,QANX,QANZER0,QANTTL,QANSERV,QANPSDO
66 K QANDOB,QANHOLD,^UTILITY($J),QANDOB,QANAGE,QANQAN,QANAGN,QANYN,POP
67 K QANEOP,QANHEAD,QANINS,QANLINE,QANRSP0,QANRSP1,QANSTAT,QANPAGE,QANCS
68 K QANDED,VAIN,VAERR,QANIRIN,QANLCTN,QANGLB0,QAUDIT,DTOUT,DUOUT,DIROUT
69 K %,%T,%W,%X,%Y,DI,DIR,DQ,J,QANIC,QANPT,QANYN,QANPT0,Y,DIRUT,%DT,DIE,DR
70 K QANPRS,QAHDNM,QAHDSSN,QAHOLD
71 Q
Note: See TracBrowser for help on using the repository browser.