50 lines
2.2 KiB
Mathematica
50 lines
2.2 KiB
Mathematica
QANPST3 ;HISC/DAD-Set OUT OF ORDER field for old PRM options ;9/16/93 08:47
|
|
;;2.0;Incident Reporting;**1,4,20**;08/07/1992
|
|
S QANSOPT="PRM"
|
|
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
|
|
. Q:$P($G(^DIC(19,QANSD0,0)),"^")'=QANSOPT
|
|
. Q:"CORW"'[$E(QANSOPT,4)
|
|
. S DIE="^DIC(19,",DA=QANSD0
|
|
. S DR="2///PACKAGE NO LONGER SUPPORTED, CONTACT THE HINES ISC"
|
|
. D ^DIE
|
|
. Q
|
|
D INACT ;Inactivate 'WITHIN 24 HOURS' in QA Type of Death file.
|
|
D NATCHK ;Check 'National Status' for incidents.
|
|
EXIT ;Kill and quit
|
|
K A1,A2,A3,C,DA,DIE,DR,QANINACT,QANNCDNT,QANOK,QANSD0,QANSLEV,QANSOPT
|
|
K X,Y
|
|
Q
|
|
INACT ;Inactivate 'WITHIN 24 HOURS' in QA Type of Death file.
|
|
S QANINACT=+$O(^QA(742.14,"BUPPER","WITHIN 24 HOURS OF ADMISSION (EX. DOA'S AND TERMINALS)",0))
|
|
Q:QANINACT'>0 ;Quit if data missing.
|
|
S DIE="^QA(742.14,",DR=".02///"_"@",DA=QANINACT D ^DIE ;Stuff 'null'
|
|
Q
|
|
NATCHK ;Check 'National Status' for incidents.
|
|
; *** Variable List ***
|
|
; A1 ---> Incident (742.1) IEN
|
|
; A2 ---> IEN for file 742.4
|
|
; A3 ---> IEN for file 742
|
|
; QANNCDNT ---> Passed into INCK^QANFULL0 incident type (free text)
|
|
; QANOK ---> Boolean for National Case Status, true or false
|
|
; QANSLEV ---> Severity Level, passed into INCK^QANFULL0
|
|
;
|
|
N QANINCD ;Protect this variable
|
|
F A1=0:0 S A1=$O(^QA(742.4,"BINC",A1)) Q:A1'>0 D
|
|
. S QANOK=0
|
|
. F A2=0:0 S A2=$O(^QA(742.4,"BINC",A1,A2)) Q:A2'>0 D
|
|
.. F A3=0:0 S A3=$O(^QA(742,"BCS",A2,A3)) Q:A3'>0 D
|
|
... S QANSLEV=+$P($G(^QA(742,A3,0)),U,10)
|
|
... S QANNCDNT=$P($G(^QA(742.1,A1,0)),U)
|
|
... S QANINCD=$$UP^XLFSTR(QANNCDNT)
|
|
... D INCK^QANFULL0 ;Check for a 'National' incident.
|
|
... S Y=$P($G(^QA(742.4,A2,0)),U,15) ;No need to '@' a null field
|
|
... I 'QANOK,(Y]"") K DA,DIE,DR S DA=A2,DIE="^QA(742.4,",DR=".17///@" ;Null implies a non-national incident.
|
|
... I 'QANOK,(Y]"") W !,"Changing Incident Record number: ",A2
|
|
... 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)
|
|
... I 'QANOK,(Y]"") W !,"To Deleted!",!
|
|
... I 'QANOK,(Y]"") D ^DIE K DA,DIE,DR
|
|
... Q
|
|
.. Q
|
|
. Q
|
|
Q
|