Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AGED11

AGED11.m

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