source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANUTL1.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1QANUTL1 ;HISC/GJC-UTILITIES FOR INCIDENT REPORTING (PATIENT DATA) ;7/12/93 09:07
2 ;;2.0;Incident Reporting;**20,27,32**;08/07/1992;Build 3
3 ;
4DICW ;Sets up output for patient lookup.
5 S QANY=$P(^QA(742,+Y,0),U),QANYY=+$P(^QA(742,+Y,0),U,3)
6 S QANSSN=$S($P(^DPT(QANY,0),U,9)]"":$P(^DPT(QANY,0),U,9),1:"")
7 N Y S Y=$P(^QA(742.4,QANYY,0),U,3) X ^DD("DD")
8 W " "_QANSSN_" "_Y_" "_$P(^QA(742.1,$P(^QA(742.4,QANYY,0),U,2),0),U)
9 K QANY,QANYY
10 Q
11HDH ;
12 S QANPAGE=QANPAGE+1 W @IOF,!?62,"Date: ",QANDT,!,?62,"Page: ",QANPAGE,!,?(IOM-$L(QANHEAD)\2),QANHEAD
13 W:QANHEAD(0)]"" !,?(IOM-$L(QANHEAD(0))\2),QANHEAD(0)
14 W:QANLINE]"" !,QANLINE,!
15 Q
16HDH1 ;
17 K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 QANEOP="^"
18 Q:QANEOP["^" D HDH
19 Q
20PAT0 ;displays the patient(s) on IR, if any.
21 S QANEE=0 N QANPTFLG
22 K QANPTS
23 F S QANEE=$O(^QA(742,"BCS",QANIEN,QANEE)) Q:QANEE'>0 D
24 . S QANPTFLG=1
25 . S QANPTS(QANEE)=$P(^QA(742,QANEE,0),U)
26 Q:'$G(QANPTFLG)
27 W !!,"Patient(s) on this Incident Report."
28 S QANCC=0
29 F S QANCC=$O(QANPTS(QANCC)) Q:QANCC'>0 D
30 . W !?5,$P(^DPT(QANPTS(QANCC),0),U)
31PAT ;Choose your patient.
32 K DIC S DIC="^QA(742,",DIC(0)="QEAMZ",DIC("A")="Select Patient: "
33 S DIC("S1")="I ""13""[+$P(^QA(742.4,+$P(^QA(742,+Y,0),U,3),0),U,8)"
34 S DIC("S2")="&($D(^QA(742,""BPRS"",1,+Y)))"
35 S DIC("S3")="I $P(^QA(742,+Y,0),U,3)=QANIEN"
36 S DIC("S")=$S(QANTYPE=3:DIC("S1")_DIC("S2"),1:DIC("S3")_DIC("S2"))
37PAT1 ;entry point from EDIT1^QANDCNT
38 S DIC("W")="D DICW^QANUTL1",D="B^BS5" D MIX^DIC1
39 I $G(X)']"" W !!,$C(7),"You must enter patient's name to continue editing." G PAT1
40 K DIC
41 I +Y=-1 S QANXIT=1 W !!,$C(7),"Patient not selected, exiting!!" Q
42 S QANDFN=+Y,QANIEN=$P(Y(0),U,3),QAHOLD=$P(Y(0),U),QAHDNM=Y(0,0)
43 S QAHDSSN=$P(^DPT(+QAHOLD,0),U,9)
44 D EDTNME Q:QANXIT
45 S QANAME=$P(^DPT(QANPAT,0),U),QANDOB=$P(^DPT(QANPAT,0),U,3),QAN(0)=0 F QAN=0:0 S QAN=$O(^QA(742,"B",QANPAT,QAN)) Q:QAN'>0!(QAN(0)'<2) S:$D(^QA(742,"B",QANPAT,QAN)) QAN(0)=QAN(0)+1
46 I QANDOB]"" S X=DT,X1=X,X2=QANDOB,X="" D:X2 ^%DTC S X=X\365.25,QANAGE=X
47 I QAN(0)'<2 D RPT0
48 Q
49RPT0 W $C(7) F W !!,"Patient has additional incidents on file.",!,"Do you wish to look at these incidents" S %=2 D YN^DICN Q:"-112"[% W !,$C(7),"Enter (Y)es, or (N)o, or ""^"" to quit."
50 S:%=-1 QANXIT=1
51 I %=-1!(%=2) Q
52 S QANPT(0)=$S($D(^DPT(QANPAT,0))#2:^(0),1:""),QANDT=DT,QANPAGE=0,Y=QANDT X ^DD("DD") S QANDT=Y,QANHEAD="Patient's Incident History.",QANHEAD(0)="",$P(QANLINE,"~",81)="",QANEOP="" D HDH
53 F QAN=0:0 S QAN=$O(^QA(742,"B",QANPAT,QAN)) Q:QAN'>0 D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W ! S QANPT0(0)=$S($D(^QA(742,QAN,0))#2:^(0),1:"") I QANPT0(0)]"" D RPT1
54 F W !!,"Do you wish to continue with the edit portion" S %=1 D YN^DICN Q:"-112"[% W !,"Enter ""Y"" for yes, ""N"" for no."
55 I %<0!(%=2) S QANXIT=1
56 Q
57RPT1 S QANCS=$P(QANPT0(0),U,3),QANCS(0)=$S($D(^QA(742.4,QANCS,0))#2:^(0),1:"") Q:QANCS(0)']""
58 S QANIC=$P(QANCS(0),U,2),QANSTAT=+$P(QANCS(0),U,8)
59 D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W !,"Patient: ",$P(QANPT(0),U),?45,"Patient ID: ",$P(QANPT0(0),U,2)
60 D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W !,"Case Number: ",$P(QANCS(0),U),?45,"Incident: ",$S(QANIC]"":$P(^QA(742.1,QANIC,0),U),1:"<NONE>")
61 D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W !,"Date of the Incident: " S Y=$P(QANCS(0),U,3) X ^DD("DD") W Y,?45,"Incident Status: ",$S(QANSTAT=0:"Closed",QANSTAT=1:"Open",QANSTAT=3:"Open",1:"Deleted")
62 D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W !,"Incident Location: " W:$P(QANCS(0),U,4)]"" $P(^QA(742.5,$P(QANCS(0),U,4),0),U)
63 D:$Y>(IOSL-4) HDH1 Q:QANEOP["^" W !,"Severity Level: " S Y=$P(QANPT0(0),U,10),C=$P(^DD(742,.1,0),U,2) I Y]"" D Y^DIQ W Y
64 Q
65ADMDT ;Grab the patient's admission date.
66 S QANWARD="" ;SETTING THE DEFAULT TO 'NULL'
67 S DFN=QANPIEN D INP^VADPT S QANADMDT=$S(VAIN(7)]"":+VAIN(7),1:"")
68 S QANTRSP=$S(VAIN(3)]"":+VAIN(3),1:"")
69 S QANINPAT=$S($D(^DPT(QANPIEN,.1)):1,1:0)
70 D:QANINPAT WARD
71 K DFN,VAIN
72 Q
73EDTNME ;Edit the patients name.
74 K DIE,DR
75 S DIE="^QA(742,",DA=+Y,DR=".01 Patient" D ^DIE
76 S:$D(Y) QANXIT=1
77 S (QANPAT,QANPIEN)=+X
78 Q:QANXIT!(+X=QAHOLD) ;Exit on abnormal exit OR same patient
79 S QA2=$G(^DPT(+X,0)),QANSSN=$P(QA2,U,9),QA1=$P(QA2,U),QANDOB=$P(QA2,U,3)
80 S QANPID=$$QANPID^QANCDNT(QA1)
81 D ADMDT ;Grab ward, t spec, admit date, and patient type for new patient
82 S QANADMDT=$S(QANADMDT]"":QANADMDT,1:"@"),QANTRSP=$S(QANTRSP]"":QANTRSP,1:"@"),QANINPAT=$S(QANINPAT]"":QANINPAT,1:"@"),QANWARD=$S(QANWARD]"":QANWARD,1:"@"),QANPID=$S(QANPID]"":QANPID,1:"")
83 S DIE="^QA(742,",DA=QANDFN
84 F DR=".02///"_QANPID,".04///"_QANADMDT,".05///"_QANINPAT,".06///"_QANWARD,".07///"_QANTRSP D ^DIE
85 K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="e",QAUDIT("COMMENT")="Editing a patient name for an incident record." D ^QAQAUDIT
86 I +$P(^QA(742.4,QANIEN,0),U,18) D ^QANPEDT ;Update patient name on NQADB
87 K QAUDIT,QA1,QANSSN,QANADMDT,QANPID,QANINPAT,QANWARD,QANTRSP,QA2,QAHOLD
88 K QAHDNM,QAHDSSN
89 Q
90WARD ;
91 S QANWARD=$S(VAIN(4)]"":+VAIN(4),1:"") Q:QANWARD=""
92 I '$D(^DIC(42,QANWARD,0)) S QANWARD="" Q
93 S QANWARD=$S($D(^DIC(42,QANWARD,44)):+$P(^(44),U),1:"") Q:QANWARD=""
94 I '$D(^SC(QANWARD,0)) S QANWARD=""
95 Q
Note: See TracBrowser for help on using the repository browser.