| 1 | QANPST3 ;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.
|
|---|
| 13 | EXIT ;Kill and quit
|
|---|
| 14 | K A1,A2,A3,C,DA,DIE,DR,QANINACT,QANNCDNT,QANOK,QANSD0,QANSLEV,QANSOPT
|
|---|
| 15 | K X,Y
|
|---|
| 16 | Q
|
|---|
| 17 | INACT ;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
|
|---|
| 22 | NATCHK ;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
|
|---|
