AGED11 ; IHS/ASDS/EFG - EDIT - PAGE 8 (ADDITIONAL REGISTRATION INFO) ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
N AD0
I AGOPT(9)'="Y" G END
VAR ;EP
;D DRAW ;WITH WRAP
D DRAWLINE ;NO FORMATTTING
Q:$D(AGSEENLY)
K DIR
S DIR("?")="Enter your choice now."
S DIR("?",1)="You can add or edit ADDITIONAL REGISTRATION INFORMATION,"
S DIR("?",2)="OR you can enter 'P#' where P stands for 'page' and '#' stands for"
S DIR("?",3)="the page you wish to jump to, OR enter '^' to go back one page"
S DIR("?",4)="OR, enter '^^' to exit the edit screens, OR RETURN to go to the next screen."
W !
I $D(^AUPNPAT(DFN,13,0)) D
. S DIR("A")="Do you wish to edit ADDITIONAL REGISTRATION INFORMATION? (Y/N) "
E S DIR("A")="Do you wish to enter ADDITIONAL REGISTRATION INFORMATION? (Y/N) "
S DIR("B")="N"
D READ^AGED1
Q:$D(DTOUT)!$D(DFOUT)
Q:$D(DUOUT)&$D(AGXTERN)
Q:$D(AGXTERN)&(Y="N")
G ^AGED11A:(Y="N")!(Y["n")
G VAR:$D(AG("ERR"))
G END:$D(DLOUT)
I (Y["Y")!(Y["y") D FORK G VAR
G:$D(AG("ED"))&'$D(AGXTERN) @("^AGED"_AG("ED"))
G VAR
DRAW ;EP - PRINT ADDITIONAL INFO LINE BY LINE. WITH WRAP FORMATTING
D HDR
K ^UTILITY($J,"W")
S DIWL=0
S DIWR=75
S DIWF="WC70|"
S STOP=0
S AD0=0
F S AD0=$O(^AUPNPAT(DFN,13,AD0)) Q:'AD0 D Q:STOP
.S X=$G(^AUPNPAT(DFN,13,AD0,0))
.D ^DIWP
.I $Y>20 K DIR S DIR(0)="E" D ^DIR S STOP=X=U Q:STOP D HDR
D ^DIWW
W !,$G(AGLINE("-"))
D VERIF^AGUTILS
Q
DRAWLINE ;EP - PRINT ADDITIONAL INFO LINE BY LINE. NO FORMATTING
S AG("PG")=8
D ^AGED
W !,$$CJ^XLFSTR("ADDITIONAL REGISTRATION INFO",IOM)
W !,$G(AGLINE("-"))
Q:'$O(^AUPNPAT(DFN,13,0))
W ! F I=0:0 S I=$O(^AUPNPAT(DFN,13,I)) Q:'I W ^(I,0),!
W !,$G(AGLINE("-"))
D VERIF^AGUTILS
Q
FORK ;EP - WHICH TO DO ADD OR EDIT
;IF THERE IS INFORMATION IN WP FIELD THEN LETS ADD IT
;I $D(^AUPNPAT(DFN,13,0)),($O(^AUPNPAT(DFN,13,""),-1)'=0) D EDIT Q
;ENTER ADD ONLY WHEN FIRST ENTERING INFORMATION
;D ADDNEW(1)
;PER MEETING OF 3/11/2005 ADRIAN SAID THE USERS WERE WORRIED THEY COULD NOT EDIT WHAT
;THEY HAD ENTERED. ADRIAN REQUESTED WE CHANGE THE EDIT OF THIS FIELD SO THAT THERE
;WAS NO TIME/DATE STAMP. I MADE CLEAR THAT IF THIS WERE THE CASE THEN THE FIELD
;COULD NO LONGER BE VIEWED AS HISTORICAL NOR IN LEGAL TERMS AS "UNEDITABLE" AS IN
;CERTAIN MEDICAL FORMS ARE NOT ALLOWED TO BE ALTERED BY LAW.
D REVEDIT ;DO REVISED EDIT
Q
;REVISED EDIT OF FIELD AFTER REQUEST FOR CHANGE AT 3/11/2005 MEETING
REVEDIT ;
K DIE,DIC,DA,DIR
S DIE="^AUPNPAT(",DR=1301,DA=DFN
D ^DIE
K DIE,DIC,DA,DIR
D UPDATE1^AGED(DUZ(2),DFN,11,"")
Q
;THIS SUB ROUTINE WA SINTIALLY REQUESTED IN PSECS AND THEN LATER REQUESTED TO
;BE REMOVED DURING TESTING PHASE
EDIT ;
N LASTLINE
K AGADINFO
M AGADINFO=^AUPNPAT(DFN,13) ;GET CURRENT INFO AND SAVE IN LOCAL ARRAY
K ^AUPNPAT(DFN,13) ;CLEAR OUT THE WP FLD
D ADDNEW(1) ;GET THE NEW INFO TO BE ADDED
;NOW ADD THE NEW STUFF TO THE OLD WHICH IS SAVED IN AGADINFO
S LASTLINE=$O(AGADINFO(""),-1) ;LAST ENTRY ASSIGNED IN THE IEN SEQUENCE
S LASTASS=$P(AGADINFO(0),U,3) ;LAST ENTRY ASSIGNED
S LASTTOT=$P(AGADINFO(0),U,4) ;LAST TOTAL # OF ENTRIES
S NEWLINE=LASTLINE+1
S NEWREC=0
F RECORD=NEWLINE:1 S NEWREC=$O(^AUPNPAT(DFN,13,NEWREC)) Q:'NEWREC D
.S LINE=$G(^AUPNPAT(DFN,13,NEWREC,0))
.S AGADINFO(RECORD,0)=LINE
.S $P(AGADINFO(0),U,3)=RECORD
.S $P(AGADINFO(0),U,4)=$P(AGADINFO(0),U,4)+1
K ^AUPNPAT(DFN,13)
M ^AUPNPAT(DFN,13)=AGADINFO ;UPDATE THE WP FLD WITH THE NEW AND OLD INFO
Q
END K AG,DTOUT,DQOUT,DFOUT,DLOUT,DA,DR
K Y,LASTLINE,LASTASS,LASTTOT,NEWLINE,NEWREC,RECORD,AGADINFO
K NEWLINES,LINE,EDITDATE,NEWLINES,X,%DT,AD0,DIWL,DIWR,DIWF,ROUTID
Q
;ADDING LINES WILL BE DONE WITHOUT ALLOWING THE USER TO EDIT LINES ALREADY ENETERED.
;THE PURPOSE OF TIME STAMPING IS TO PROVIDE A DIRECT LINK BETWEEN
;THE ENTRY OF DATA AND THE USER WHO ENTERED IT. IF THE USER IS
;ALLOWED TO EDIT THE TIME/DATE STAMP THERE IS NO LEGITIMACY TO IT'S
;IMPLEMENTATION
ADDNEW(FIRSTLIN) ;EP - ADD ADDITIONAL REGISTRATION INFORMATION
N LASTLINE
S DIE="^AUPNPAT(",DR=1301,DA=DFN D ^DIE ;ACTUAL ADD
; CANNOT CONTROL EDITING
; OF LINES ALREADY ENTERED
S NEWLINES=$P($G(^AUPNPAT(DFN,13,0)),U,4) ;GET THE NEW LINE TOTAL
Q:NEWLINES=""
S AGINITIL=$P($G(^VA(200,DUZ,0)),U,2) ;GET USER INITIAL
S X="NOW",%DT="T" D ^%DT
X ^DD("DD")
S EDITDATE=Y
S LINE=$G(^AUPNPAT(DFN,13,FIRSTLIN,0)) ;ADD TIME/DATE STAMP TO
; FIRST LINE ENTERED
S LINE=EDITDATE_","_LINE
S ^AUPNPAT(DFN,13,FIRSTLIN,0)=LINE
S LINE=$G(^AUPNPAT(DFN,13,NEWLINES,0))
S LINE=LINE_" ,"_AGINITIL ;ADD INITIALS TO LAST
; LINE ENTERED
S ^AUPNPAT(DFN,13,NEWLINES,0)=LINE
S ^AUPNPAT(DFN,13,NEWLINES+1,0)=" ",$P(^AUPNPAT(DFN,13,0),U,4)=$P($G(^AUPNPAT(DFN,13,0)),U,4)+1,$P(^AUPNPAT(DFN,13,0),U,3)=NEWLINES+1
D UPDATE1^AGED(DUZ(2),DFN,11,"") ;MOVED FROM ABOVE
Q
HDR ;EP
S AG("PG")=8
S ROUTID=$P($T(+1)," ") ;SET ROUTINE ID FOR PROGRAMMER VIEW
D ^AGED
W !,$$CJ^XLFSTR("ADDITIONAL REGISTRATION INFO",IOM),!
W AGLINE("-")
Q
ADD ;EP - Add a Patient.
I AGOPT(9)="Y" D FORK
G ADD^AGED13
AGED11 ; IHS/ASDS/EFG - EDIT - PAGE 8 (ADDITIONAL REGISTRATION INFO) ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 NEW AD0
+4 IF AGOPT(9)'="Y"
GOTO END
VAR ;EP
+1 ;D DRAW ;WITH WRAP
+2 ;NO FORMATTTING
DO DRAWLINE
+3 IF $DATA(AGSEENLY)
QUIT
+4 KILL DIR
+5 SET DIR("?")="Enter your choice now."
+6 SET DIR("?",1)="You can add or edit ADDITIONAL REGISTRATION INFORMATION,"
+7 SET DIR("?",2)="OR you can enter 'P#' where P stands for 'page' and '#' stands for"
+8 SET DIR("?",3)="the page you wish to jump to, OR enter '^' to go back one page"
+9 SET DIR("?",4)="OR, enter '^^' to exit the edit screens, OR RETURN to go to the next screen."
+10 WRITE !
+11 IF $DATA(^AUPNPAT(DFN,13,0))
Begin DoDot:1
+12 SET DIR("A")="Do you wish to edit ADDITIONAL REGISTRATION INFORMATION? (Y/N) "
End DoDot:1
+13 IF '$TEST
SET DIR("A")="Do you wish to enter ADDITIONAL REGISTRATION INFORMATION? (Y/N) "
+14 SET DIR("B")="N"
+15 DO READ^AGED1
+16 IF $DATA(DTOUT)!$DATA(DFOUT)
QUIT
+17 IF $DATA(DUOUT)&$DATA(AGXTERN)
QUIT
+18 IF $DATA(AGXTERN)&(Y="N")
QUIT
+19 IF (Y="N")!(Y["n")
GOTO ^AGED11A
+20 IF $DATA(AG("ERR"))
GOTO VAR
+21 IF $DATA(DLOUT)
GOTO END
+22 IF (Y["Y")!(Y["y")
DO FORK
GOTO VAR
+23 IF $DATA(AG("ED"))&'$DATA(AGXTERN)
GOTO @("^AGED"_AG("ED"))
+24 GOTO VAR
DRAW ;EP - PRINT ADDITIONAL INFO LINE BY LINE. WITH WRAP FORMATTING
+1 DO HDR
+2 KILL ^UTILITY($JOB,"W")
+3 SET DIWL=0
+4 SET DIWR=75
+5 SET DIWF="WC70|"
+6 SET STOP=0
+7 SET AD0=0
+8 FOR
SET AD0=$ORDER(^AUPNPAT(DFN,13,AD0))
IF 'AD0
QUIT
Begin DoDot:1
+9 SET X=$GET(^AUPNPAT(DFN,13,AD0,0))
+10 DO ^DIWP
+11 IF $Y>20
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET STOP=X=U
IF STOP
QUIT
DO HDR
End DoDot:1
IF STOP
QUIT
+12 DO ^DIWW
+13 WRITE !,$GET(AGLINE("-"))
+14 DO VERIF^AGUTILS
+15 QUIT
DRAWLINE ;EP - PRINT ADDITIONAL INFO LINE BY LINE. NO FORMATTING
+1 SET AG("PG")=8
+2 DO ^AGED
+3 WRITE !,$$CJ^XLFSTR("ADDITIONAL REGISTRATION INFO",IOM)
+4 WRITE !,$GET(AGLINE("-"))
+5 IF '$ORDER(^AUPNPAT(DFN,13,0))
QUIT
+6 WRITE !
FOR I=0:0
SET I=$ORDER(^AUPNPAT(DFN,13,I))
IF 'I
QUIT
WRITE ^(I,0),!
+7 WRITE !,$GET(AGLINE("-"))
+8 DO VERIF^AGUTILS
+9 QUIT
FORK ;EP - WHICH TO DO ADD OR EDIT
+1 ;IF THERE IS INFORMATION IN WP FIELD THEN LETS ADD IT
+2 ;I $D(^AUPNPAT(DFN,13,0)),($O(^AUPNPAT(DFN,13,""),-1)'=0) D EDIT Q
+3 ;ENTER ADD ONLY WHEN FIRST ENTERING INFORMATION
+4 ;D ADDNEW(1)
+5 ;PER MEETING OF 3/11/2005 ADRIAN SAID THE USERS WERE WORRIED THEY COULD NOT EDIT WHAT
+6 ;THEY HAD ENTERED. ADRIAN REQUESTED WE CHANGE THE EDIT OF THIS FIELD SO THAT THERE
+7 ;WAS NO TIME/DATE STAMP. I MADE CLEAR THAT IF THIS WERE THE CASE THEN THE FIELD
+8 ;COULD NO LONGER BE VIEWED AS HISTORICAL NOR IN LEGAL TERMS AS "UNEDITABLE" AS IN
+9 ;CERTAIN MEDICAL FORMS ARE NOT ALLOWED TO BE ALTERED BY LAW.
+10 ;DO REVISED EDIT
DO REVEDIT
+11 QUIT
+12 ;REVISED EDIT OF FIELD AFTER REQUEST FOR CHANGE AT 3/11/2005 MEETING
REVEDIT ;
+1 KILL DIE,DIC,DA,DIR
+2 SET DIE="^AUPNPAT("
SET DR=1301
SET DA=DFN
+3 DO ^DIE
+4 KILL DIE,DIC,DA,DIR
+5 DO UPDATE1^AGED(DUZ(2),DFN,11,"")
+6 QUIT
+7 ;THIS SUB ROUTINE WA SINTIALLY REQUESTED IN PSECS AND THEN LATER REQUESTED TO
+8 ;BE REMOVED DURING TESTING PHASE
EDIT ;
+1 NEW LASTLINE
+2 KILL AGADINFO
+3 ;GET CURRENT INFO AND SAVE IN LOCAL ARRAY
MERGE AGADINFO=^AUPNPAT(DFN,13)
+4 ;CLEAR OUT THE WP FLD
KILL ^AUPNPAT(DFN,13)
+5 ;GET THE NEW INFO TO BE ADDED
DO ADDNEW(1)
+6 ;NOW ADD THE NEW STUFF TO THE OLD WHICH IS SAVED IN AGADINFO
+7 ;LAST ENTRY ASSIGNED IN THE IEN SEQUENCE
SET LASTLINE=$ORDER(AGADINFO(""),-1)
+8 ;LAST ENTRY ASSIGNED
SET LASTASS=$PIECE(AGADINFO(0),U,3)
+9 ;LAST TOTAL # OF ENTRIES
SET LASTTOT=$PIECE(AGADINFO(0),U,4)
+10 SET NEWLINE=LASTLINE+1
+11 SET NEWREC=0
+12 FOR RECORD=NEWLINE:1
SET NEWREC=$ORDER(^AUPNPAT(DFN,13,NEWREC))
IF 'NEWREC
QUIT
Begin DoDot:1
+13 SET LINE=$GET(^AUPNPAT(DFN,13,NEWREC,0))
+14 SET AGADINFO(RECORD,0)=LINE
+15 SET $PIECE(AGADINFO(0),U,3)=RECORD
+16 SET $PIECE(AGADINFO(0),U,4)=$PIECE(AGADINFO(0),U,4)+1
End DoDot:1
+17 KILL ^AUPNPAT(DFN,13)
+18 ;UPDATE THE WP FLD WITH THE NEW AND OLD INFO
MERGE ^AUPNPAT(DFN,13)=AGADINFO
+19 QUIT
END KILL AG,DTOUT,DQOUT,DFOUT,DLOUT,DA,DR
+1 KILL Y,LASTLINE,LASTASS,LASTTOT,NEWLINE,NEWREC,RECORD,AGADINFO
+2 KILL NEWLINES,LINE,EDITDATE,NEWLINES,X,%DT,AD0,DIWL,DIWR,DIWF,ROUTID
+3 QUIT
+4 ;ADDING LINES WILL BE DONE WITHOUT ALLOWING THE USER TO EDIT LINES ALREADY ENETERED.
+5 ;THE PURPOSE OF TIME STAMPING IS TO PROVIDE A DIRECT LINK BETWEEN
+6 ;THE ENTRY OF DATA AND THE USER WHO ENTERED IT. IF THE USER IS
+7 ;ALLOWED TO EDIT THE TIME/DATE STAMP THERE IS NO LEGITIMACY TO IT'S
+8 ;IMPLEMENTATION
ADDNEW(FIRSTLIN) ;EP - ADD ADDITIONAL REGISTRATION INFORMATION
+1 NEW LASTLINE
+2 ;ACTUAL ADD
SET DIE="^AUPNPAT("
SET DR=1301
SET DA=DFN
DO ^DIE
+3 ; CANNOT CONTROL EDITING
+4 ; OF LINES ALREADY ENTERED
+5 ;GET THE NEW LINE TOTAL
SET NEWLINES=$PIECE($GET(^AUPNPAT(DFN,13,0)),U,4)
+6 IF NEWLINES=""
QUIT
+7 ;GET USER INITIAL
SET AGINITIL=$PIECE($GET(^VA(200,DUZ,0)),U,2)
+8 SET X="NOW"
SET %DT="T"
DO ^%DT
+9 XECUTE ^DD("DD")
+10 SET EDITDATE=Y
+11 ;ADD TIME/DATE STAMP TO
SET LINE=$GET(^AUPNPAT(DFN,13,FIRSTLIN,0))
+12 ; FIRST LINE ENTERED
+13 SET LINE=EDITDATE_","_LINE
+14 SET ^AUPNPAT(DFN,13,FIRSTLIN,0)=LINE
+15 SET LINE=$GET(^AUPNPAT(DFN,13,NEWLINES,0))
+16 ;ADD INITIALS TO LAST
SET LINE=LINE_" ,"_AGINITIL
+17 ; LINE ENTERED
+18 SET ^AUPNPAT(DFN,13,NEWLINES,0)=LINE
+19 SET ^AUPNPAT(DFN,13,NEWLINES+1,0)=" "
SET $PIECE(^AUPNPAT(DFN,13,0),U,4)=$PIECE($GET(^AUPNPAT(DFN,13,0)),U,4)+1
SET $PIECE(^AUPNPAT(DFN,13,0),U,3)=NEWLINES+1
+20 ;MOVED FROM ABOVE
DO UPDATE1^AGED(DUZ(2),DFN,11,"")
+21 QUIT
HDR ;EP
+1 SET AG("PG")=8
+2 ;SET ROUTINE ID FOR PROGRAMMER VIEW
SET ROUTID=$PIECE($TEXT(+1)," ")
+3 DO ^AGED
+4 WRITE !,$$CJ^XLFSTR("ADDITIONAL REGISTRATION INFO",IOM),!
+5 WRITE AGLINE("-")
+6 QUIT
ADD ;EP - Add a Patient.
+1 IF AGOPT(9)="Y"
DO FORK
+2 GOTO ADD^AGED13
