source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANPST3.m@ 861

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1QANPST3 ;HISC/DAD-Set OUT OF ORDER field for old PRM options ;9/16/93 08:47
2 ;;2.0;Incident Reporting;**1,4,20**;08/07/1992
3 S QANSOPT="PRM"
4 F S QANSOPT=$O(^DIC(19,"B",QANSOPT)) Q:(QANSOPT="")!($E(QANSOPT,1,3)'="PRM") F QANSD0=0:0 S QANSD0=$O(^DIC(19,"B",QANSOPT,QANSD0)) Q:QANSD0'>0 D
5 . Q:$P($G(^DIC(19,QANSD0,0)),"^")'=QANSOPT
6 . Q:"CORW"'[$E(QANSOPT,4)
7 . S DIE="^DIC(19,",DA=QANSD0
8 . S DR="2///PACKAGE NO LONGER SUPPORTED, CONTACT THE HINES ISC"
9 . D ^DIE
10 . Q
11 D INACT ;Inactivate 'WITHIN 24 HOURS' in QA Type of Death file.
12 D NATCHK ;Check 'National Status' for incidents.
13EXIT ;Kill and quit
14 K A1,A2,A3,C,DA,DIE,DR,QANINACT,QANNCDNT,QANOK,QANSD0,QANSLEV,QANSOPT
15 K X,Y
16 Q
17INACT ;Inactivate 'WITHIN 24 HOURS' in QA Type of Death file.
18 S QANINACT=+$O(^QA(742.14,"BUPPER","WITHIN 24 HOURS OF ADMISSION (EX. DOA'S AND TERMINALS)",0))
19 Q:QANINACT'>0 ;Quit if data missing.
20 S DIE="^QA(742.14,",DR=".02///"_"@",DA=QANINACT D ^DIE ;Stuff 'null'
21 Q
22NATCHK ;Check 'National Status' for incidents.
23 ; *** Variable List ***
24 ; A1 ---> Incident (742.1) IEN
25 ; A2 ---> IEN for file 742.4
26 ; A3 ---> IEN for file 742
27 ; QANNCDNT ---> Passed into INCK^QANFULL0 incident type (free text)
28 ; QANOK ---> Boolean for National Case Status, true or false
29 ; QANSLEV ---> Severity Level, passed into INCK^QANFULL0
30 ;
31 N QANINCD ;Protect this variable
32 F A1=0:0 S A1=$O(^QA(742.4,"BINC",A1)) Q:A1'>0 D
33 . S QANOK=0
34 . F A2=0:0 S A2=$O(^QA(742.4,"BINC",A1,A2)) Q:A2'>0 D
35 .. F A3=0:0 S A3=$O(^QA(742,"BCS",A2,A3)) Q:A3'>0 D
36 ... S QANSLEV=+$P($G(^QA(742,A3,0)),U,10)
37 ... S QANNCDNT=$P($G(^QA(742.1,A1,0)),U)
38 ... S QANINCD=$$UP^XLFSTR(QANNCDNT)
39 ... D INCK^QANFULL0 ;Check for a 'National' incident.
40 ... S Y=$P($G(^QA(742.4,A2,0)),U,15) ;No need to '@' a null field
41 ... I 'QANOK,(Y]"") K DA,DIE,DR S DA=A2,DIE="^QA(742.4,",DR=".17///@" ;Null implies a non-national incident.
42 ... I 'QANOK,(Y]"") W !,"Changing Incident Record number: ",A2
43 ... I 'QANOK,(Y]"") W !,"Changing the National Case Status from: " S Y=$P($G(^QA(742.4,A2,0)),U,15),C=$P(^DD(742.4,.17,0),U,2) D:Y]"" Y^DIQ W $S(Y="":"N/A",1:Y)
44 ... I 'QANOK,(Y]"") W !,"To Deleted!",!
45 ... I 'QANOK,(Y]"") D ^DIE K DA,DIE,DR
46 ... Q
47 .. Q
48 . Q
49 Q
Note: See TracBrowser for help on using the repository browser.