- QAOEDT3 ;HISC/DAD-BASIC OCCURRENCE SCREEN DATA EDIT ;6/11/93 15:45
- ;;3.0;Occurrence Screen;;09/14/1993
- EN2 ; *** BASIC OS DATA
- S QALIMIT="I $P(^(0),""^"",11)'>0",QAOSPROG="EN3^QAOEDT3" D EN2^QAOEDT
- EXIT ;
- K %,DA,DIC,DIE,DR,I,LINE,LOC,QA,QADATE,QALIMIT,QAOPCENT,QAOS,QAOSD0
- K QAOSDATE,QAOSQUIT,QAOSWHAT,QAOSSCRN,QAUDIT,QAOSWHO,X,Y,QAOSDEAD
- K QAOSDATE,QAOSSCRN,QAOSDFN,QAOSIEN,QAOS109,QAORESET,QAOSONE,QAOSPROG
- Q
- EN3 ; MAIN LOOP
- S QAOSWHAT="REVIEWED" D ENDISP^QAOUTL0 S (QAOSQUIT,QAORESET)=0
- S X=$G(^QA(741,QAOSD0,0)),QAOSSCRN(0)=+$G(^("SCRN"))
- S QAOSDATE(0)=+$P(X,"^",3),QAOSDFN=+X
- EDIT K DR S DIE="^QA(741,",DR="19;1;3",DA=QAOSD0 D ^DIE S:$D(Y) QAOSQUIT=1
- S QAOSDATE(1)=+$P($G(^QA(741,QAOSD0,0)),"^",3),QAOSSCRN(1)=+$G(^("SCRN"))
- S QAOS109=+$O(^QA(741.1,"B",109,0))
- D 21,23:QAOSDEAD(0)>1 G:QAOSQUIT=1 AUDIT
- I QAORESET S QAOSQUIT=0 G EDIT
- K DR S DIE="^QA(741,",DR="4;5;6;7;8;9",DA=QAOSD0
- D ^DIE S:$D(Y) QAOSQUIT=1
- AUDIT S QAUDIT("FILE")="741^27",QAUDIT("DA")=QAOSD0,QAUDIT("ACTION")="e"
- S QAUDIT("COMMENT")="CHANGE BASIC OCCURRENCE DATA" D ^QAQAUDIT
- K QAOSDEAD,QAOSDATE,QAOSSCRN,QAOSDFN,QAOSIEN
- Q
- 21 N Y S (QAORESET,QAOSDEAD,QAOSDEAD(0))=0
- S QA=$S(QAOSDATE(0)<QAOSDATE(1):QAOSDATE(0),1:QAOSDATE(1))-.0000001
- F QAOSDATE=QA:0 S QAOSDATE=$O(^QA(741,"AA",QAOS109,QAOSDATE)) Q:QAOSDATE'>0 F QAOSIEN=0:0 S QAOSIEN=$O(^QA(741,"AA",QAOS109,QAOSDATE,QAOSDFN,QAOSIEN)) Q:QAOSIEN'>0 D 22
- Q
- 22 S X=$G(^QA(741,QAOSIEN,0)) Q:$P(X,"^",11)=2 S Y=+$G(^("SCRN"))
- Q:Y'=QAOS109 S QAOSDEAD=X,QAOSDEAD(0)=QAOSDEAD(0)+1
- Q:QAOSDATE(1)'>$P(QAOSDEAD,"^",3) S QAOSDEAD(0)=0
- W *7,!!?5,"You cannot enter an occurrence date after the date of death "
- S Y=$P(QAOSDEAD,"^",3)\1 X ^DD("DD") W Y,".",*7 D RESET
- Q
- 23 N Y W *7
- W !!?5,"You cannot enter more than one death for the same patient.",*7
- D RESET
- Q
- RESET W !?5,"Resetting the occurrence date and screen to their original values.",!
- K DR S DIE="^QA(741,",DA=QAOSD0
- S DR="1///"_QAOSDATE(0)_";3///`"_QAOSSCRN(0)
- D ^DIE S QAORESET=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOEDT3 2034 printed Feb 18, 2025@23:47:37 Page 2
- QAOEDT3 ;HISC/DAD-BASIC OCCURRENCE SCREEN DATA EDIT ;6/11/93 15:45
- +1 ;;3.0;Occurrence Screen;;09/14/1993
- EN2 ; *** BASIC OS DATA
- +1 SET QALIMIT="I $P(^(0),""^"",11)'>0"
- SET QAOSPROG="EN3^QAOEDT3"
- DO EN2^QAOEDT
- EXIT ;
- +1 KILL %,DA,DIC,DIE,DR,I,LINE,LOC,QA,QADATE,QALIMIT,QAOPCENT,QAOS,QAOSD0
- +2 KILL QAOSDATE,QAOSQUIT,QAOSWHAT,QAOSSCRN,QAUDIT,QAOSWHO,X,Y,QAOSDEAD
- +3 KILL QAOSDATE,QAOSSCRN,QAOSDFN,QAOSIEN,QAOS109,QAORESET,QAOSONE,QAOSPROG
- +4 QUIT
- EN3 ; MAIN LOOP
- +1 SET QAOSWHAT="REVIEWED"
- DO ENDISP^QAOUTL0
- SET (QAOSQUIT,QAORESET)=0
- +2 SET X=$GET(^QA(741,QAOSD0,0))
- SET QAOSSCRN(0)=+$GET(^("SCRN"))
- +3 SET QAOSDATE(0)=+$PIECE(X,"^",3)
- SET QAOSDFN=+X
- EDIT KILL DR
- SET DIE="^QA(741,"
- SET DR="19;1;3"
- SET DA=QAOSD0
- DO ^DIE
- if $DATA(Y)
- SET QAOSQUIT=1
- +1 SET QAOSDATE(1)=+$PIECE($GET(^QA(741,QAOSD0,0)),"^",3)
- SET QAOSSCRN(1)=+$GET(^("SCRN"))
- +2 SET QAOS109=+$ORDER(^QA(741.1,"B",109,0))
- +3 DO 21
- if QAOSDEAD(0)>1
- DO 23
- if QAOSQUIT=1
- GOTO AUDIT
- +4 IF QAORESET
- SET QAOSQUIT=0
- GOTO EDIT
- +5 KILL DR
- SET DIE="^QA(741,"
- SET DR="4;5;6;7;8;9"
- SET DA=QAOSD0
- +6 DO ^DIE
- if $DATA(Y)
- SET QAOSQUIT=1
- AUDIT SET QAUDIT("FILE")="741^27"
- SET QAUDIT("DA")=QAOSD0
- SET QAUDIT("ACTION")="e"
- +1 SET QAUDIT("COMMENT")="CHANGE BASIC OCCURRENCE DATA"
- DO ^QAQAUDIT
- +2 KILL QAOSDEAD,QAOSDATE,QAOSSCRN,QAOSDFN,QAOSIEN
- +3 QUIT
- 21 NEW Y
- SET (QAORESET,QAOSDEAD,QAOSDEAD(0))=0
- +1 SET QA=$SELECT(QAOSDATE(0)<QAOSDATE(1):QAOSDATE(0),1:QAOSDATE(1))-.0000001
- +2 FOR QAOSDATE=QA:0
- SET QAOSDATE=$ORDER(^QA(741,"AA",QAOS109,QAOSDATE))
- if QAOSDATE'>0
- QUIT
- FOR QAOSIEN=0:0
- SET QAOSIEN=$ORDER(^QA(741,"AA",QAOS109,QAOSDATE,QAOSDFN,QAOSIEN))
- if QAOSIEN'>0
- QUIT
- DO 22
- +3 QUIT
- 22 SET X=$GET(^QA(741,QAOSIEN,0))
- if $PIECE(X,"^",11)=2
- QUIT
- SET Y=+$GET(^("SCRN"))
- +1 if Y'=QAOS109
- QUIT
- SET QAOSDEAD=X
- SET QAOSDEAD(0)=QAOSDEAD(0)+1
- +2 if QAOSDATE(1)'>$PIECE(QAOSDEAD,"^",3)
- QUIT
- SET QAOSDEAD(0)=0
- +3 WRITE *7,!!?5,"You cannot enter an occurrence date after the date of death "
- +4 SET Y=$PIECE(QAOSDEAD,"^",3)\1
- XECUTE ^DD("DD")
- WRITE Y,".",*7
- DO RESET
- +5 QUIT
- 23 NEW Y
- WRITE *7
- +1 WRITE !!?5,"You cannot enter more than one death for the same patient.",*7
- +2 DO RESET
- +3 QUIT
- RESET WRITE !?5,"Resetting the occurrence date and screen to their original values.",!
- +1 KILL DR
- SET DIE="^QA(741,"
- SET DA=QAOSD0
- +2 SET DR="1///"_QAOSDATE(0)_";3///`"_QAOSSCRN(0)
- +3 DO ^DIE
- SET QAORESET=1
- +4 QUIT