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

PXCEVFI2.m

Go to the documentation of this file. 
  1. PXCEVFI2 ;ISL/dee,ESW - Supporting routines for editing a visit or v-file entry ; 11/6/02 2:36pm
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73,95,96**;Aug 12, 1996
  1.  ;; ;
  1.  Q
  1. ASK(PXCVIEN,PXCFIEN,PXCEAUPN,PXCCATT,PXCCODE) ; -- Display a selection list from one V-File for this visit
  1.  N PXCEINDX,PXCECNT,PXCEASK,PXCEREF
  1.  N DIR,DA,X,Y
  1.  S PXCEINDX=""
  1.  F PXCECNT=0:1 S PXCEINDX=$O(@(PXCEAUPN_"(""AD"",PXCVIEN,PXCEINDX)")) Q:'PXCEINDX  D
  1.  . W:PXCECNT=0 !!,"--- "_PXCCATT_" ---",!
  1.  . S PXCEASK(PXCECNT+1)=PXCEINDX
  1.  . W !,$J(PXCECNT+1,3),?6,@("$$DISPLY01^"_PXCCODE_"("_PXCEAUPN_"(PXCEINDX,0))")
  1.  Q:PXCECNT'>0
  1. ASKLOOP S DIR(0)="FAO^1:"_$L(PXCECNT)
  1.  S DIR("A")="Enter 1-"_PXCECNT_" to Edit, or 'A' to Add: "
  1.  S DIR("?")="Enter the number of the "_PXCCATT_" you wish to edit or A to add a new "_PXCCATT_"."
  1.  D ^DIR
  1.  K DIR,DA
  1.  I $D(DIRUT) S PXCEQUIT=1 Q
  1.  Q:"Aa"[Y
  1.  G:Y<1!(Y>PXCECNT) ASKLOOP
  1.  G:$G(PXCEASK(Y))'>0 ASKLOOP
  1.  S PXCFIEN=$G(PXCEASK(Y))
  1.  Q
  1.  ;
  1. SAVE ; -- Save this edited and quit editing.
  1.  I PXCECAT="CSTP" S PXCEFIEN=$$STOPCODE^PXUTLSTP(PXCESOR,$P(PXCEAFTR(0),"^",8),PXCEVIEN)
  1.  E  D
  1.  . N PXCENODS,PXCEFOR,PXCENODE,PXCESEQ
  1.  . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
  1.  . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']""  D
  1.  .. I PXCENODE=1,PXCECATS="CPT" D  Q
  1.  ... S PXCESEQ=""
  1.  ... F  S PXCESEQ=$O(PXCEAFTR(PXCENODE,PXCESEQ)) Q:PXCESEQ=""  D
  1.  .... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"AFTER")=PXCEAFTR(PXCENODE,PXCESEQ)
  1.  .. S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"AFTER")=PXCEAFTR(PXCENODE)
  1.  . I PXCECAT="SK",^TMP("PXK",$J,PXCECATS,1,"IEN")]"" D SAVE^PXCESK
  1.  . D EN1^PXKMAIN
  1.  . I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") S PXCEVIEN=^TMP("PXK",$J,"VST",1,"IEN")
  1.  Q
  1.  ;
  1. DEL(PXCECAT) ; -- Delete this V-File entry from the List if all the visit infomation.
  1.  I PXCEFIEN'>0!(PXCEVIEN'>0) W !!,$C(7),"Error: Cannot delete this an unknown V-File entry." D PAUSE^PXCEHELP Q
  1.  I PXCEKEYS'["D",PXCEKEYS'["d" W !!,$C(7),"Error: You do not have delete access." D PAUSE^PXCEHELP Q
  1.  ;
  1.  N PXCENODS,PXCEFOR,PXCENODE,PXCECATS,PXCECATT,PXCECODE,PXCEAUPN,PXCEQUIT
  1.  S PXCECODE="PXCE"_$S(PXCECAT="IMM":"VIMM",1:PXCECAT)
  1.  S PXCECATS=$S(PXCECAT="CSTP":"VST",PXCECAT="HIST":"VST",1:PXCECAT)
  1.  S PXCEAUPN=$P($T(FORMAT^@PXCECODE),"~",5)
  1.  S PXCECATT=$P($P($T(FORMAT^@PXCECODE),";;",2),"~",1)
  1.  ;
  1.  I '$D(@(PXCEAUPN_"(PXCEFIEN)")) Q
  1.  I $P($G(@(PXCEAUPN_"(PXCEFIEN,812)")),"^",1) D  Q
  1.  . W !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(@(PXCEAUPN_""(PXCEFIEN,0)""))")
  1.  . W !,"Error: You cannot delete this entry it has been ""Verified""." D WAIT^PXCEHELP
  1.  I PXCEKEYS'["D" D  Q:PXCEQUIT
  1.  . N PXCECHK
  1.  . S PXCEQUIT=0
  1.  . I PXCECATS="VST" S PXCECHK=$P($G(@(PXCEAUPN_"(PXCEFIEN,0)")),"^",23)
  1.  . E  S PXCECHK=$P($P($P($G(@(PXCEAUPN_"(PXCEFIEN,801)")),"^",2),";",1)," ",2)
  1.  . I DUZ'=PXCECHK D
  1.  .. S PXCEQUIT=1
  1.  .. N NODE0
  1.  .. S NODE0=@(PXCEAUPN_"(PXCEFIEN,0)")
  1.  .. W !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(NODE0)")
  1.  .. W !,"Error: You cannot delete an entry you did not create." D WAIT^PXCEHELP
  1.  ;
  1.  I PXCECAT="CSTP" D
  1.  . W !!,"Deleting "_PXCECATT_" "
  1.  . W @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")))")
  1.  . Q:'$$SURE^PXCEAE2
  1.  . N PXCERESU
  1.  . S PXCERESU=$$STOPCODE^PXUTLSTP(PXCESOR,"@",PXCEVIEN,PXCEFIEN)
  1.  . S:$D(PXCELOOP) PXCELOOP=1
  1.  E  I PXCECATS="VST" D
  1.  . W !!,"Deleting "_PXCECATT_" "
  1.  . W @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")))")
  1.  . Q:'$$SURE^PXCEAE2
  1.  . N PXCERESU
  1.  . S PXCERESU=$$KILL^VSITKIL(PXCEVIEN)
  1.  . I PXCERESU D
  1.  .. I PXCERESU=1,$O(^SCE("AVSIT",PXCEVIEN,"")) Q
  1.  .. W !,$C(7),"Could not delete the encounter.  There are still users of it." D WAIT^PXCEHELP
  1.  . I 'PXCERESU S PXCEVDEL=1 S:$D(PXCELOOP) (PXCELOOP,PXCEQUIT,PXCENOER)=1
  1.  . D EVENT^PXKMAIN
  1.  ;
  1.  E  D
  1.  . K ^TMP("PXK",$J)
  1.  . S ^TMP("PXK",$J,"VST",1,"IEN")=PXCEVIEN
  1.  . F PXCENODE=0,21,150,800,811,812 D
  1.  .. S (^TMP("PXK",$J,"VST",1,PXCENODE,"AFTER"),^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE"))=$G(^AUPNVSIT(PXCEVIEN,PXCENODE))
  1.  . ;
  1.  . S ^TMP("PXK",$J,"SOR")=PXCESOR
  1.  . S ^TMP("PXK",$J,PXCECATS,1,"IEN")=PXCEFIEN
  1.  . ;
  1.  . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
  1.  . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']""  D
  1.  .. S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
  1.  . ;
  1.  . N DIK,DA
  1.  . W !!,"Deleting "_PXCECATT_" "
  1.  . W @("$$DISPLY01^"_PXCECODE_"(^TMP(""PXK"",$J,PXCECATS,1,0,""BEFORE""))")
  1.  . Q:'$$SURE^PXCEAE2  ;DELQUIT
  1.  . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
  1.  . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']""  S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"AFTER")=$S(PXCENODE=0:"@",1:"")
  1.  . D EN1^PXKMAIN
  1.  . S:$D(PXCELOOP) PXCELOOP=1
  1.  . I $D(PXCENOER)#2 S PXCENOER=1
  1.  ;
  1. DELQUIT ;
  1.  K ^TMP("PXK",$J)
  1.  Q
  1.  ;