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 ;05/03/2024@10:58
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73,95,96,124,158,184,215,211,217,235,240**;Aug 12, 1996;Build 55
  1. ; Reference to ^DIC(31) in ICR #792
  1. ; Reference to ^DIC(391) in ICR #1112
  1. ; Reference to ^SCE(DA,0) in ICR #2065
  1. ; Reference to INP^SDAM2 in ICR #1582
  1. ; Reference to REQ^SDM1A in ICR #1583
  1. ; Reference to CLINIC^SDAMU in ICR #1580
  1. ; Reference to EXOE^SDCOU2 in ICR #1015
  1. ; Reference to CLOE^SDCO21 in ICR #1300
  1. ; Reference to SEQ^SDCO21 in ICR #1300
  1. ; Reference to CL^SDCO21 in ICR #1300
  1. ; Reference to ^SCE("AVSIT") in ICR #2045
  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,PXCEDT
  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. . I PXCECNT=0&(PXCCATT="Diagnosis") D SC($P(^AUPNVSIT(PXCEVIEN,0),U,5))
  1. . I PXCECNT=0&(PXCCATT="CPT") D SC($P(^AUPNVSIT(PXCEVIEN,0),U,5))
  1. . W:PXCECNT=0 !!,"--- "_PXCCATT_" ---",!
  1. . S PXCEASK(PXCECNT+1)=PXCEINDX
  1. . S PXCEDT=$P($G(@(PXCEAUPN_"(PXCEINDX,12)")),U,1)
  1. . I PXCEDT="" S PXCEDT=$P(^AUPNVSIT(PXCEVIEN,0),U,1)
  1. . W !,$J(PXCECNT+1,3),?6,@("$$DISPLY01^"_PXCCODE_"("_PXCEAUPN_"(PXCEINDX,0),PXCEDT)")
  1. Q:PXCECNT'>0
  1. ASKLOOP S DIR(0)="FAO^1:"_$L(PXCECNT)
  1. I PXCECAT="IMM" D
  1. . S DIR("A",1)="Enter 1-"_PXCECNT_" to Edit, 'A' to Add, or"
  1. . S DIR("A")=" 'C' to document a Contraindication/Refusal: "
  1. . S DIR("?",1)="Enter the number of the "_PXCCATT_" you wish to edit, A to add a"
  1. . S DIR("?")="new "_PXCCATT_", or 'C' to document a Contraindication/Refusal."
  1. E D
  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. I "Cc"[Y S PXVICR=1 Q
  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",$G(^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 information.
  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. N PXCEDT
  1. ;
  1. ; Check to see if there is a skin test placement linked to this entry
  1. I PXCECAT="SK",'$$CANDEL^PXCESK(PXCEFIEN) Q
  1. ;
  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. S PXCEDT=$P($G(@(PXCEAUPN_"(PXCEFIEN,12)")),U,1)
  1. I PXCEDT="" S PXCEDT=$P(^AUPNVSIT(PXCEVIEN,0),U,1)
  1. I $P($G(@(PXCEAUPN_"(PXCEFIEN,812)")),"^",1) D Q
  1. . W !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(@(PXCEAUPN_""(PXCEFIEN,0)""),PXCEDT)")
  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,PXCEDT)")
  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)"")),PXCEDT)")
  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)"")),PXCEDT)")
  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""),PXCEDT)")
  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. ;
  1. SC(PXDFN) ;Service Connected Help
  1. ; Input -- DFN Patient file IEN
  1. ; Output -- Help
  1. N I,SDCNT,SDDC,SDRD0
  1. W !!,"Patient's Service Connection and Rated Disabilities:"
  1. W !!,$S($P($G(^DPT(PXDFN,.3)),"^")="Y":" SC Percent: "_$P(^(.3),"^",2)_"%",1:" Service Connected: No")
  1. W !,"Rated Disabilities: "
  1. I $P($G(^DPT(PXDFN,"VET")),"^")'="Y",$S('$D(^DIC(391,+$G(^DPT(PXDFN,"TYPE")),0)):1,$P(^(0),"^",2):0,1:1) W "Not a Veteran" Q
  1. S (SDCNT,I)=0
  1. F S I=$O(^DPT(PXDFN,.372,I)) Q:'I I $P($G(^(I,0)),"^",3) S SDRD0=^(0) D
  1. .S SDCNT=SDCNT+1
  1. .S SDDC=$S('$D(^DIC(31,+SDRD0,0)):"",$P(^(0),"^",4)]"":$P(^(0),"^",4),1:$P(^(0),"^"))
  1. .W:SDCNT>1 !
  1. .W ?20,$P($G(^DIC(31,+SDRD0,0)),"^",3),?25,SDDC," (",$P(SDRD0,"^",2),"%-",$S($P(SDRD0,"^",3):"SC",1:""),")"
  1. I 'SDCNT W $S('$O(^DPT(PXDFN,.372,0)):"None Stated",1:"No Service Connected Disabilities Listed")
  1. ;
  1. Q