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

GMRCAD31.m

Go to the documentation of this file. 
  1. GMRCAD31 ;SLC/JFR - admin corrections on cons. activities; 2/19/03 14:09
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**32**;DEC 27, 1997
  1. EN ;Start prompting and prepare to build a list
  1.  N GMRCIEN
  1.  S GMRCIEN=$$GETCSLT
  1.  I 'GMRCIEN W !,"No Consult selected." Q
  1.  I '$$CKACTS(GMRCIEN) D  G EN
  1.  . W !,"The request has no activities meeting editing criteria"
  1.  . H 2
  1.  D BLDLST(GMRCIEN)
  1.  D EN^VALM("GMRC ADM31")
  1.  Q
  1.  ;
  1. GETCSLT() ;
  1.  N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
  1.  D EN^DDIOL("You may only select IFC requests ordered at your facility")
  1.  D EN^DDIOL(" ")
  1.  S DIR(0)="PAO^123"
  1.  S DIR("?")="Select an inter-facility request being performed elsewhere"
  1.  S DIR("A")="Select Consult #: "
  1.  S DIR("S")="I $P($G(^GMR(123,+Y,12)),U,5)=""P"""
  1.  D ^DIR
  1.  I '$G(Y) Q ""
  1.  Q +Y
  1.  Q
  1.  ;
  1. NEWCSLT ; select a new consult to work on
  1.  D FULL^VALM1
  1.  N GMRCIEN
  1.  S GMRCIEN=$$GETCSLT
  1.  I 'GMRCIEN D  D INIT Q
  1.  . N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
  1.  . S DIR(0)="E" D ^DIR
  1.  . Q
  1.  I '$$CKACTS(GMRCIEN) D  D INIT Q
  1.  . W !,"The request has no activities meeting editing criteria"
  1.  D EXIT,BLDLST(GMRCIEN),INIT
  1.  Q
  1.  ;
  1. SELACT ; choose which action to edit
  1.  D FULL^VALM1
  1.  N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y,GMRCO
  1.  D EN^DDIOL("You may only select one of the listed activities.")
  1.  D EN^DDIOL(" ")
  1.  S DIR(0)="NAO^2:50"
  1.  S DIR("A")="Select an activity from the list by number: "
  1.  D ^DIR
  1.  I $D(DIRUT) S VALMBCK="R" Q
  1.  I '$D(^TMP("GMRCADM",$J,"B",+Y)) D  G SELACT
  1.  . D EN^DDIOL("That is not a listed activity",,"!!?5")
  1.  S GMRCO=$G(^TMP("GMRCADM",$J,"CSLT"))
  1.  D FIX(GMRCO,+Y)
  1.  D EXIT,BLDLST(GMRCO),INIT
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. BLDLST(GMRCDA) ;build the list for LM
  1.  ; Input: 
  1.  ;  GMRCDA = ien from file 123
  1.  ;
  1.  K ^TMP("GMRCADM",$J)
  1.  N PTNM,PTSSN,REMSIT,REMNUM,GMRCCT,TAB
  1.  S ^TMP("GMRCADM",$J,"CSLT")=GMRCDA
  1.  S GMRCCT=1,TAB=$$REPEAT^XLFSTR(" ",29)
  1.  S PTNM="Patient name: "_$$GET1^DIQ(123,GMRCDA,.02,"E")
  1.  S PTSSN="SSN: "_$$GET1^DIQ(2,$P(^GMR(123,GMRCDA,0),U,2),.09)
  1.  S REMSIT="Receiving Site: "
  1.  S REMSIT=REMSIT_$$GET1^DIQ(4,$P(^GMR(123,GMRCDA,0),U,23),.01)
  1.  S REMNUM="Remote Consult #: "_$P(^GMR(123,GMRCDA,0),U,22)
  1.  S ^TMP("GMRCADM",$J,GMRCCT,0)="Consult #: "_GMRCDA
  1.  S GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCADM",$J,GMRCCT,0)=PTNM_"      "_PTSSN
  1.  S GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCADM",$J,GMRCCT,0)=REMSIT_"   "_REMNUM
  1.  S GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCADM",$J,GMRCCT,0)="",GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCADM",$J,GMRCCT,0)="Facility",GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCADM",$J,GMRCCT,0)=" Activity"_$E(TAB,1,16)_"Date/Time/Zone"_$E(TAB,1,6)_"Responsible Person"_$E(TAB,1,2)_"Entered By",GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCADM",$J,GMRCCT,0)=$$REPEAT^XLFSTR("-",79)
  1.  S GMRCCT=GMRCCT+1
  1.  N ACTV
  1.  S ACTV=0
  1.  F  S ACTV=$O(^GMR(123,GMRCDA,40,ACTV)) Q:'ACTV  D
  1.  . N ACTYPE
  1.  . S ACTYPE=$P(^GMR(123,GMRCDA,40,ACTV,0),U,2)
  1.  . Q:ACTYPE'=17&(ACTYPE'=4)  ;only FWD and SF are affected
  1.  . Q:'$D(^GMR(123,GMRCDA,40,ACTV,2))  ;only remote activities
  1.  . Q:'$O(^GMR(123,GMRCDA,40,ACTV,1,1))
  1.  . S ^TMP("GMRCADM",$J,"B",ACTV)=GMRCCT
  1.  . S ^TMP("GMRCADM",$J,GMRCCT,0)="    Act. #: "_ACTV,GMRCCT=GMRCCT+1
  1.  . D BLDALN^GMRCSLM4(GMRCDA,ACTV)
  1.  . M ^TMP("GMRCADM",$J)=^TMP("GMRCR",$J,"DT")
  1.  . K ^TMP("GMRCR",$J,"DT")
  1.  . S ^TMP("GMRCADM",$J,GMRCCT,0)="",GMRCCT=GMRCCT+1
  1.  . Q
  1.  Q
  1.  ;
  1. INIT ;
  1.  S VALMCNT=$O(^TMP("GMRCADM",$J," "),-1)
  1.  S VALMBG=1
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. EXIT ;
  1.  K ^TMP("GMRCADM",$J)
  1.  S VALMBCK="Q"
  1.  Q
  1.  ;
  1. HDR ;
  1.  S VALMHDR(1)=$$CJ^XLFSTR(("Consult #:"_^TMP("GMRCADM",$J,"CSLT")),80)
  1.  Q
  1. CKACTS(CSLT) ;assure that there is at least one activity meeting criteria
  1.  ; Input:
  1.  ;   CSLT = ien from file 123
  1.  ;
  1.  N ACTV,OK
  1.  S ACTV=0,OK=0
  1.  F  S ACTV=$O(^GMR(123,CSLT,40,ACTV)) Q:'ACTV!(OK=1)  D
  1.  . N ACTYPE
  1.  . S ACTYPE=$P(^GMR(123,CSLT,40,ACTV,0),U,2)
  1.  . I ACTYPE=17 S OK=1 ; FWD action
  1.  . I ACTYPE=4 S OK=1 ; SF action
  1.  . I OK,'$D(^GMR(123,CSLT,40,ACTV,2)) S OK=0 ;only remote activities
  1.  . I OK,'$O(^GMR(123,CSLT,40,ACTV,1,1)) S OK=0 ;only those with comments
  1.  Q OK
  1.  ;
  1. FIX(GMRCDA,GMRCACT) ;do the admin correction on bad IFC comments
  1.  ; GMRCDA  = ien from file 123
  1.  ; GMRCACT = ien within 40 multiple for activity
  1.  ;
  1.  I '$D(^GMR(123,GMRCDA,40,1)) D  Q
  1.  . W !,"No comment there to correct"
  1.  K ^TMP("GMRCOCMT",$J)
  1.  M ^TMP("GMRCOCMT",$J)=^GMR(123,GMRCDA,40,GMRCACT,1)
  1.  W !!
  1.  N DIE,DR,DA,CHGD
  1.  S CHGD=0
  1.  S DA=GMRCACT,DA(1)=GMRCDA,DR=5,DIE="^GMR(123,"_DA(1)_",40,"
  1.  D ^DIE
  1.  I $O(^GMR(123,GMRCDA,40,GMRCACT,1," "),-1)'=$O(^TMP("GMRCOCMT",$J," "),-1) S CHGD=1
  1.  I 'CHGD D
  1.  . N I S I=0
  1.  . F  S I=$O(^GMR(123,GMRCDA,40,GMRCACT,1,I)) Q:'I!(CHGD)  D
  1.  .. I ^GMR(123,GMRCDA,40,GMRCACT,1,I,0)'=^TMP("GMRCOCMT",$J,I,0) S CHGD=1
  1.  .. Q
  1.  I 'CHGD W !,"No comment modification made!",!
  1.  I CHGD D AUDIT(GMRCDA,GMRCACT,$NA(^TMP("GMRCOCMT",$J)))
  1.  K ^TMP("GMRCOCMT",$J)
  1.  Q
  1.  ;
  1. AUDIT(GMRCO,GMRCAC,ARRAY) ;make new audit trail activity w/old and new
  1.  ;Input: 
  1.  ;  GMRCO  = ien from file 123
  1.  ;  GMRCAC = IEN WITHIN 40 MULTIPLE
  1.  ;  ARRAY  = array containing the old comment
  1.  N GMRCA,GMRCAD,GMRCMT,GMRCDA,DA,NUM,I
  1.  N ACTYPE,ACTWHO,ACTRESP,ACTWHEN
  1.  I '$G(GMRCO) Q
  1.  ; load up particulars about edited activity, then load old comment
  1.  ; then load up new comment in GMRCMT local array
  1.  S ACTYPE=$$GET1^DIQ(123.1,$P(^GMR(123,GMRCO,40,GMRCAC,0),U,2),.01)
  1.  S ACTWHO=$P(^GMR(123,GMRCO,40,GMRCAC,2),U)
  1.  S ACTRESP=$P(^GMR(123,GMRCO,40,GMRCAC,2),U,2)
  1.  D  ;GET VALUE OF ACTWHEN
  1.  . N X
  1.  . S X=$P(^GMR(123,GMRCO,40,GMRCAC,2),U,5) D REGDTM^GMRCU
  1.  . S ACTWHEN=X_" "_$P(^GMR(123,GMRCO,40,GMRCAC,2),U,3)
  1.  S NUM=1
  1.  S GMRCMT(NUM)=" ",NUM=NUM+1
  1.  S GMRCMT(NUM)="The "_ACTYPE_" action, added "_ACTWHEN_" by",NUM=NUM+1
  1.  S GMRCMT(NUM)=ACTWHO_" "_$S($L(ACTRESP):("for "_ACTRESP),1:"")_","
  1.  S GMRCMT(NUM)=GMRCMT(NUM)_" has been administratively corrected."
  1.  S NUM=NUM+1,GMRCMT(NUM)=" ",NUM=NUM+1
  1.  S GMRCMT(NUM)="The comment was corrected from:",NUM=NUM+1
  1.  S GMRCMT(NUM)=" ",NUM=NUM+1
  1.  S I=0 ;load up old comment
  1.  F  S I=$O(^TMP("GMRCOCMT",$J,I)) Q:'I  D
  1.  . S GMRCMT(NUM)=^TMP("GMRCOCMT",$J,I,0),NUM=NUM+1
  1.  S GMRCMT(NUM)=" ",NUM=NUM+1
  1.  S GMRCMT(NUM)="The comment was corrected to: ",NUM=NUM+1
  1.  S GMRCMT(NUM)=" ",NUM=NUM+1
  1.  S I=0 ;load up current comment
  1.  F  S I=$O(^GMR(123,GMRCO,40,GMRCAC,1,I)) Q:'I  D
  1.  . S GMRCMT(NUM)=^GMR(123,GMRCO,40,GMRCAC,1,I,0)
  1.  . S NUM=NUM+1
  1.  ;
  1.  ; file admin correct comment
  1.  S GMRCDA=$$SETDA^GMRCGUIB ; get new activity ien
  1.  S GMRCA=26,GMRCAD=$$NOW^XLFDT,DA=GMRCDA
  1.  D SETCOM^GMRCGUIB(.GMRCMT,DUZ)
  1.  Q