- PXCEVFI2 ;ISL/DEE,ESW - Supporting routines for editing a visit or v-file entry ;05/03/2024@10:58
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73,95,96,124,158,184,215,211,217,235,240**;Aug 12, 1996;Build 55
- ; Reference to ^DIC(31) in ICR #792
- ; Reference to ^DIC(391) in ICR #1112
- ; Reference to ^SCE(DA,0) in ICR #2065
- ; Reference to INP^SDAM2 in ICR #1582
- ; Reference to REQ^SDM1A in ICR #1583
- ; Reference to CLINIC^SDAMU in ICR #1580
- ; Reference to EXOE^SDCOU2 in ICR #1015
- ; Reference to CLOE^SDCO21 in ICR #1300
- ; Reference to SEQ^SDCO21 in ICR #1300
- ; Reference to CL^SDCO21 in ICR #1300
- ; Reference to ^SCE("AVSIT") in ICR #2045
- ;
- Q
- ASK(PXCVIEN,PXCFIEN,PXCEAUPN,PXCCATT,PXCCODE) ; -- Display a selection list from one V-File for this visit
- N PXCEINDX,PXCECNT,PXCEASK,PXCEREF,PXCEDT
- N DIR,DA,X,Y
- S PXCEINDX=""
- F PXCECNT=0:1 S PXCEINDX=$O(@(PXCEAUPN_"(""AD"",PXCVIEN,PXCEINDX)")) Q:'PXCEINDX D
- . I PXCECNT=0&(PXCCATT="Diagnosis") D SC($P(^AUPNVSIT(PXCEVIEN,0),U,5))
- . I PXCECNT=0&(PXCCATT="CPT") D SC($P(^AUPNVSIT(PXCEVIEN,0),U,5))
- . W:PXCECNT=0 !!,"--- "_PXCCATT_" ---",!
- . S PXCEASK(PXCECNT+1)=PXCEINDX
- . S PXCEDT=$P($G(@(PXCEAUPN_"(PXCEINDX,12)")),U,1)
- . I PXCEDT="" S PXCEDT=$P(^AUPNVSIT(PXCEVIEN,0),U,1)
- . W !,$J(PXCECNT+1,3),?6,@("$$DISPLY01^"_PXCCODE_"("_PXCEAUPN_"(PXCEINDX,0),PXCEDT)")
- Q:PXCECNT'>0
- ASKLOOP S DIR(0)="FAO^1:"_$L(PXCECNT)
- I PXCECAT="IMM" D
- . S DIR("A",1)="Enter 1-"_PXCECNT_" to Edit, 'A' to Add, or"
- . S DIR("A")=" 'C' to document a Contraindication/Refusal: "
- . S DIR("?",1)="Enter the number of the "_PXCCATT_" you wish to edit, A to add a"
- . S DIR("?")="new "_PXCCATT_", or 'C' to document a Contraindication/Refusal."
- E D
- . S DIR("A")="Enter 1-"_PXCECNT_" to Edit, or 'A' to Add: "
- . S DIR("?")="Enter the number of the "_PXCCATT_" you wish to edit or A to add a new "_PXCCATT_"."
- D ^DIR
- K DIR,DA
- I $D(DIRUT) S PXCEQUIT=1 Q
- Q:"Aa"[Y
- I "Cc"[Y S PXVICR=1 Q
- G:Y<1!(Y>PXCECNT) ASKLOOP
- G:$G(PXCEASK(Y))'>0 ASKLOOP
- S PXCFIEN=$G(PXCEASK(Y))
- Q
- ;
- SAVE ; -- Save this edited and quit editing.
- I PXCECAT="CSTP" S PXCEFIEN=$$STOPCODE^PXUTLSTP(PXCESOR,$P(PXCEAFTR(0),"^",8),PXCEVIEN)
- E D
- . N PXCENODS,PXCEFOR,PXCENODE,PXCESEQ
- . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
- . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" D
- .. I PXCENODE=1,PXCECATS="CPT" D Q
- ... S PXCESEQ=""
- ... F S PXCESEQ=$O(PXCEAFTR(PXCENODE,PXCESEQ)) Q:PXCESEQ="" D
- .... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"AFTER")=PXCEAFTR(PXCENODE,PXCESEQ)
- .. S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"AFTER")=PXCEAFTR(PXCENODE)
- . I PXCECAT="SK",$G(^TMP("PXK",$J,PXCECATS,1,"IEN"))]"" D SAVE^PXCESK
- . D EN1^PXKMAIN
- . I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") S PXCEVIEN=^TMP("PXK",$J,"VST",1,"IEN")
- Q
- ;
- DEL(PXCECAT) ; -- Delete this V-File entry from the List if all the visit information.
- I PXCEFIEN'>0!(PXCEVIEN'>0) W !!,$C(7),"Error: Cannot delete this an unknown V-File entry." D PAUSE^PXCEHELP Q
- I PXCEKEYS'["D",PXCEKEYS'["d" W !!,$C(7),"Error: You do not have delete access." D PAUSE^PXCEHELP Q
- ;
- N PXCENODS,PXCEFOR,PXCENODE,PXCECATS,PXCECATT,PXCECODE,PXCEAUPN,PXCEQUIT
- N PXCEDT
- ;
- ; Check to see if there is a skin test placement linked to this entry
- I PXCECAT="SK",'$$CANDEL^PXCESK(PXCEFIEN) Q
- ;
- S PXCECODE="PXCE"_$S(PXCECAT="IMM":"VIMM",1:PXCECAT)
- S PXCECATS=$S(PXCECAT="CSTP":"VST",PXCECAT="HIST":"VST",1:PXCECAT)
- S PXCEAUPN=$P($T(FORMAT^@PXCECODE),"~",5)
- S PXCECATT=$P($P($T(FORMAT^@PXCECODE),";;",2),"~",1)
- ;
- I '$D(@(PXCEAUPN_"(PXCEFIEN)")) Q
- S PXCEDT=$P($G(@(PXCEAUPN_"(PXCEFIEN,12)")),U,1)
- I PXCEDT="" S PXCEDT=$P(^AUPNVSIT(PXCEVIEN,0),U,1)
- I $P($G(@(PXCEAUPN_"(PXCEFIEN,812)")),"^",1) D Q
- . W !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(@(PXCEAUPN_""(PXCEFIEN,0)""),PXCEDT)")
- . W !,"Error: You cannot delete this entry it has been ""Verified""." D WAIT^PXCEHELP
- I PXCEKEYS'["D" D Q:PXCEQUIT
- . N PXCECHK
- . S PXCEQUIT=0
- . I PXCECATS="VST" S PXCECHK=$P($G(@(PXCEAUPN_"(PXCEFIEN,0)")),"^",23)
- . E S PXCECHK=$P($P($P($G(@(PXCEAUPN_"(PXCEFIEN,801)")),"^",2),";",1)," ",2)
- . I DUZ'=PXCECHK D
- .. S PXCEQUIT=1
- .. N NODE0
- .. S NODE0=@(PXCEAUPN_"(PXCEFIEN,0)")
- .. W !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(NODE0,PXCEDT)")
- .. W !,"Error: You cannot delete an entry you did not create." D WAIT^PXCEHELP
- ;
- I PXCECAT="CSTP" D
- . W !!,"Deleting "_PXCECATT_" "
- . W @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")),PXCEDT)")
- . Q:'$$SURE^PXCEAE2
- . N PXCERESU
- . S PXCERESU=$$STOPCODE^PXUTLSTP(PXCESOR,"@",PXCEVIEN,PXCEFIEN)
- . S:$D(PXCELOOP) PXCELOOP=1
- E I PXCECATS="VST" D
- . W !!,"Deleting "_PXCECATT_" "
- . W @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")),PXCEDT)")
- . Q:'$$SURE^PXCEAE2
- . N PXCERESU
- . S PXCERESU=$$KILL^VSITKIL(PXCEVIEN)
- . I PXCERESU D
- .. I PXCERESU=1,$O(^SCE("AVSIT",PXCEVIEN,"")) Q
- .. W !,$C(7),"Could not delete the encounter. There are still users of it." D WAIT^PXCEHELP
- . I 'PXCERESU S PXCEVDEL=1 S:$D(PXCELOOP) (PXCELOOP,PXCEQUIT,PXCENOER)=1
- . D EVENT^PXKMAIN
- ;
- E D
- . K ^TMP("PXK",$J)
- . S ^TMP("PXK",$J,"VST",1,"IEN")=PXCEVIEN
- . F PXCENODE=0,21,150,800,811,812 D
- .. S (^TMP("PXK",$J,"VST",1,PXCENODE,"AFTER"),^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE"))=$G(^AUPNVSIT(PXCEVIEN,PXCENODE))
- . ;
- . S ^TMP("PXK",$J,"SOR")=PXCESOR
- . S ^TMP("PXK",$J,PXCECATS,1,"IEN")=PXCEFIEN
- . ;
- . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
- . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" D
- .. S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
- . ;
- . N DIK,DA
- . W !!,"Deleting "_PXCECATT_" "
- . W @("$$DISPLY01^"_PXCECODE_"(^TMP(""PXK"",$J,PXCECATS,1,0,""BEFORE""),PXCEDT)")
- . Q:'$$SURE^PXCEAE2 ;DELQUIT
- . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
- . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"AFTER")=$S(PXCENODE=0:"@",1:"")
- . D EN1^PXKMAIN
- . S:$D(PXCELOOP) PXCELOOP=1
- . I $D(PXCENOER)#2 S PXCENOER=1
- ;
- DELQUIT ;
- K ^TMP("PXK",$J)
- Q
- ;
- SC(PXDFN) ;Service Connected Help
- ; Input -- DFN Patient file IEN
- ; Output -- Help
- N I,SDCNT,SDDC,SDRD0
- W !!,"Patient's Service Connection and Rated Disabilities:"
- W !!,$S($P($G(^DPT(PXDFN,.3)),"^")="Y":" SC Percent: "_$P(^(.3),"^",2)_"%",1:" Service Connected: No")
- W !,"Rated Disabilities: "
- 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
- S (SDCNT,I)=0
- F S I=$O(^DPT(PXDFN,.372,I)) Q:'I I $P($G(^(I,0)),"^",3) S SDRD0=^(0) D
- .S SDCNT=SDCNT+1
- .S SDDC=$S('$D(^DIC(31,+SDRD0,0)):"",$P(^(0),"^",4)]"":$P(^(0),"^",4),1:$P(^(0),"^"))
- .W:SDCNT>1 !
- .W ?20,$P($G(^DIC(31,+SDRD0,0)),"^",3),?25,SDDC," (",$P(SDRD0,"^",2),"%-",$S($P(SDRD0,"^",3):"SC",1:""),")"
- I 'SDCNT W $S('$O(^DPT(PXDFN,.372,0)):"None Stated",1:"No Service Connected Disabilities Listed")
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEVFI2 7074 printed Jan 18, 2025@03:29:21 Page 2
- 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
- +2 ; Reference to ^DIC(31) in ICR #792
- +3 ; Reference to ^DIC(391) in ICR #1112
- +4 ; Reference to ^SCE(DA,0) in ICR #2065
- +5 ; Reference to INP^SDAM2 in ICR #1582
- +6 ; Reference to REQ^SDM1A in ICR #1583
- +7 ; Reference to CLINIC^SDAMU in ICR #1580
- +8 ; Reference to EXOE^SDCOU2 in ICR #1015
- +9 ; Reference to CLOE^SDCO21 in ICR #1300
- +10 ; Reference to SEQ^SDCO21 in ICR #1300
- +11 ; Reference to CL^SDCO21 in ICR #1300
- +12 ; Reference to ^SCE("AVSIT") in ICR #2045
- +13 ;
- +14 QUIT
- ASK(PXCVIEN,PXCFIEN,PXCEAUPN,PXCCATT,PXCCODE) ; -- Display a selection list from one V-File for this visit
- +1 NEW PXCEINDX,PXCECNT,PXCEASK,PXCEREF,PXCEDT
- +2 NEW DIR,DA,X,Y
- +3 SET PXCEINDX=""
- +4 FOR PXCECNT=0:1
- SET PXCEINDX=$ORDER(@(PXCEAUPN_"(""AD"",PXCVIEN,PXCEINDX)"))
- if 'PXCEINDX
- QUIT
- Begin DoDot:1
- +5 IF PXCECNT=0&(PXCCATT="Diagnosis")
- DO SC($PIECE(^AUPNVSIT(PXCEVIEN,0),U,5))
- +6 IF PXCECNT=0&(PXCCATT="CPT")
- DO SC($PIECE(^AUPNVSIT(PXCEVIEN,0),U,5))
- +7 if PXCECNT=0
- WRITE !!,"--- "_PXCCATT_" ---",!
- +8 SET PXCEASK(PXCECNT+1)=PXCEINDX
- +9 SET PXCEDT=$PIECE($GET(@(PXCEAUPN_"(PXCEINDX,12)")),U,1)
- +10 IF PXCEDT=""
- SET PXCEDT=$PIECE(^AUPNVSIT(PXCEVIEN,0),U,1)
- +11 WRITE !,$JUSTIFY(PXCECNT+1,3),?6,@("$$DISPLY01^"_PXCCODE_"("_PXCEAUPN_"(PXCEINDX,0),PXCEDT)")
- End DoDot:1
- +12 if PXCECNT'>0
- QUIT
- ASKLOOP SET DIR(0)="FAO^1:"_$LENGTH(PXCECNT)
- +1 IF PXCECAT="IMM"
- Begin DoDot:1
- +2 SET DIR("A",1)="Enter 1-"_PXCECNT_" to Edit, 'A' to Add, or"
- +3 SET DIR("A")=" 'C' to document a Contraindication/Refusal: "
- +4 SET DIR("?",1)="Enter the number of the "_PXCCATT_" you wish to edit, A to add a"
- +5 SET DIR("?")="new "_PXCCATT_", or 'C' to document a Contraindication/Refusal."
- End DoDot:1
- +6 IF '$TEST
- Begin DoDot:1
- +7 SET DIR("A")="Enter 1-"_PXCECNT_" to Edit, or 'A' to Add: "
- +8 SET DIR("?")="Enter the number of the "_PXCCATT_" you wish to edit or A to add a new "_PXCCATT_"."
- End DoDot:1
- +9 DO ^DIR
- +10 KILL DIR,DA
- +11 IF $DATA(DIRUT)
- SET PXCEQUIT=1
- QUIT
- +12 if "Aa"[Y
- QUIT
- +13 IF "Cc"[Y
- SET PXVICR=1
- QUIT
- +14 if Y<1!(Y>PXCECNT)
- GOTO ASKLOOP
- +15 if $GET(PXCEASK(Y))'>0
- GOTO ASKLOOP
- +16 SET PXCFIEN=$GET(PXCEASK(Y))
- +17 QUIT
- +18 ;
- SAVE ; -- Save this edited and quit editing.
- +1 IF PXCECAT="CSTP"
- SET PXCEFIEN=$$STOPCODE^PXUTLSTP(PXCESOR,$PIECE(PXCEAFTR(0),"^",8),PXCEVIEN)
- +2 IF '$TEST
- Begin DoDot:1
- +3 NEW PXCENODS,PXCEFOR,PXCENODE,PXCESEQ
- +4 SET PXCENODS=$PIECE($TEXT(FORMAT^@PXCECODE),"~",3)
- +5 FOR PXCEFOR=1:1
- SET PXCENODE=$PIECE(PXCENODS,",",PXCEFOR)
- if PXCENODE']""
- QUIT
- Begin DoDot:2
- +6 IF PXCENODE=1
- IF PXCECATS="CPT"
- Begin DoDot:3
- +7 SET PXCESEQ=""
- +8 FOR
- SET PXCESEQ=$ORDER(PXCEAFTR(PXCENODE,PXCESEQ))
- if PXCESEQ=""
- QUIT
- Begin DoDot:4
- +9 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,PXCESEQ,"AFTER")=PXCEAFTR(PXCENODE,PXCESEQ)
- End DoDot:4
- End DoDot:3
- QUIT
- +10 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"AFTER")=PXCEAFTR(PXCENODE)
- End DoDot:2
- +11 IF PXCECAT="SK"
- IF $GET(^TMP("PXK",$JOB,PXCECATS,1,"IEN"))]""
- DO SAVE^PXCESK
- +12 DO EN1^PXKMAIN
- +13 IF PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST")
- SET PXCEVIEN=^TMP("PXK",$JOB,"VST",1,"IEN")
- End DoDot:1
- +14 QUIT
- +15 ;
- DEL(PXCECAT) ; -- Delete this V-File entry from the List if all the visit information.
- +1 IF PXCEFIEN'>0!(PXCEVIEN'>0)
- WRITE !!,$CHAR(7),"Error: Cannot delete this an unknown V-File entry."
- DO PAUSE^PXCEHELP
- QUIT
- +2 IF PXCEKEYS'["D"
- IF PXCEKEYS'["d"
- WRITE !!,$CHAR(7),"Error: You do not have delete access."
- DO PAUSE^PXCEHELP
- QUIT
- +3 ;
- +4 NEW PXCENODS,PXCEFOR,PXCENODE,PXCECATS,PXCECATT,PXCECODE,PXCEAUPN,PXCEQUIT
- +5 NEW PXCEDT
- +6 ;
- +7 ; Check to see if there is a skin test placement linked to this entry
- +8 IF PXCECAT="SK"
- IF '$$CANDEL^PXCESK(PXCEFIEN)
- QUIT
- +9 ;
- +10 SET PXCECODE="PXCE"_$SELECT(PXCECAT="IMM":"VIMM",1:PXCECAT)
- +11 SET PXCECATS=$SELECT(PXCECAT="CSTP":"VST",PXCECAT="HIST":"VST",1:PXCECAT)
- +12 SET PXCEAUPN=$PIECE($TEXT(FORMAT^@PXCECODE),"~",5)
- +13 SET PXCECATT=$PIECE($PIECE($TEXT(FORMAT^@PXCECODE),";;",2),"~",1)
- +14 ;
- +15 IF '$DATA(@(PXCEAUPN_"(PXCEFIEN)"))
- QUIT
- +16 SET PXCEDT=$PIECE($GET(@(PXCEAUPN_"(PXCEFIEN,12)")),U,1)
- +17 IF PXCEDT=""
- SET PXCEDT=$PIECE(^AUPNVSIT(PXCEVIEN,0),U,1)
- +18 IF $PIECE($GET(@(PXCEAUPN_"(PXCEFIEN,812)")),"^",1)
- Begin DoDot:1
- +19 WRITE !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(@(PXCEAUPN_""(PXCEFIEN,0)""),PXCEDT)")
- +20 WRITE !,"Error: You cannot delete this entry it has been ""Verified""."
- DO WAIT^PXCEHELP
- End DoDot:1
- QUIT
- +21 IF PXCEKEYS'["D"
- Begin DoDot:1
- +22 NEW PXCECHK
- +23 SET PXCEQUIT=0
- +24 IF PXCECATS="VST"
- SET PXCECHK=$PIECE($GET(@(PXCEAUPN_"(PXCEFIEN,0)")),"^",23)
- +25 IF '$TEST
- SET PXCECHK=$PIECE($PIECE($PIECE($GET(@(PXCEAUPN_"(PXCEFIEN,801)")),"^",2),";",1)," ",2)
- +26 IF DUZ'=PXCECHK
- Begin DoDot:2
- +27 SET PXCEQUIT=1
- +28 NEW NODE0
- +29 SET NODE0=@(PXCEAUPN_"(PXCEFIEN,0)")
- +30 WRITE !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(NODE0,PXCEDT)")
- +31 WRITE !,"Error: You cannot delete an entry you did not create."
- DO WAIT^PXCEHELP
- End DoDot:2
- End DoDot:1
- if PXCEQUIT
- QUIT
- +32 ;
- +33 IF PXCECAT="CSTP"
- Begin DoDot:1
- +34 WRITE !!,"Deleting "_PXCECATT_" "
- +35 WRITE @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")),PXCEDT)")
- +36 if '$$SURE^PXCEAE2
- QUIT
- +37 NEW PXCERESU
- +38 SET PXCERESU=$$STOPCODE^PXUTLSTP(PXCESOR,"@",PXCEVIEN,PXCEFIEN)
- +39 if $DATA(PXCELOOP)
- SET PXCELOOP=1
- End DoDot:1
- +40 IF '$TEST
- IF PXCECATS="VST"
- Begin DoDot:1
- +41 WRITE !!,"Deleting "_PXCECATT_" "
- +42 WRITE @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")),PXCEDT)")
- +43 if '$$SURE^PXCEAE2
- QUIT
- +44 NEW PXCERESU
- +45 SET PXCERESU=$$KILL^VSITKIL(PXCEVIEN)
- +46 IF PXCERESU
- Begin DoDot:2
- +47 IF PXCERESU=1
- IF $ORDER(^SCE("AVSIT",PXCEVIEN,""))
- QUIT
- +48 WRITE !,$CHAR(7),"Could not delete the encounter. There are still users of it."
- DO WAIT^PXCEHELP
- End DoDot:2
- +49 IF 'PXCERESU
- SET PXCEVDEL=1
- if $DATA(PXCELOOP)
- SET (PXCELOOP,PXCEQUIT,PXCENOER)=1
- +50 DO EVENT^PXKMAIN
- End DoDot:1
- +51 ;
- +52 IF '$TEST
- Begin DoDot:1
- +53 KILL ^TMP("PXK",$JOB)
- +54 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXCEVIEN
- +55 FOR PXCENODE=0,21,150,800,811,812
- Begin DoDot:2
- +56 SET (^TMP("PXK",$JOB,"VST",1,PXCENODE,"AFTER"),^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE"))=$GET(^AUPNVSIT(PXCEVIEN,PXCENODE))
- End DoDot:2
- +57 ;
- +58 SET ^TMP("PXK",$JOB,"SOR")=PXCESOR
- +59 SET ^TMP("PXK",$JOB,PXCECATS,1,"IEN")=PXCEFIEN
- +60 ;
- +61 SET PXCENODS=$PIECE($TEXT(FORMAT^@PXCECODE),"~",3)
- +62 FOR PXCEFOR=1:1
- SET PXCENODE=$PIECE(PXCENODS,",",PXCEFOR)
- if PXCENODE']""
- QUIT
- Begin DoDot:2
- +63 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")=$GET(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
- End DoDot:2
- +64 ;
- +65 NEW DIK,DA
- +66 WRITE !!,"Deleting "_PXCECATT_" "
- +67 WRITE @("$$DISPLY01^"_PXCECODE_"(^TMP(""PXK"",$J,PXCECATS,1,0,""BEFORE""),PXCEDT)")
- +68 ;DELQUIT
- if '$$SURE^PXCEAE2
- QUIT
- +69 SET PXCENODS=$PIECE($TEXT(FORMAT^@PXCECODE),"~",3)
- +70 FOR PXCEFOR=1:1
- SET PXCENODE=$PIECE(PXCENODS,",",PXCEFOR)
- if PXCENODE']""
- QUIT
- SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"AFTER")=$SELECT(PXCENODE=0:"@",1:"")
- +71 DO EN1^PXKMAIN
- +72 if $DATA(PXCELOOP)
- SET PXCELOOP=1
- +73 IF $DATA(PXCENOER)#2
- SET PXCENOER=1
- End DoDot:1
- +74 ;
- DELQUIT ;
- +1 KILL ^TMP("PXK",$JOB)
- +2 QUIT
- +3 ;
- SC(PXDFN) ;Service Connected Help
- +1 ; Input -- DFN Patient file IEN
- +2 ; Output -- Help
- +3 NEW I,SDCNT,SDDC,SDRD0
- +4 WRITE !!,"Patient's Service Connection and Rated Disabilities:"
- +5 WRITE !!,$SELECT($PIECE($GET(^DPT(PXDFN,.3)),"^")="Y":" SC Percent: "_$PIECE(^(.3),"^",2)_"%",1:" Service Connected: No")
- +6 WRITE !,"Rated Disabilities: "
- +7 IF $PIECE($GET(^DPT(PXDFN,"VET")),"^")'="Y"
- IF $SELECT('$DATA(^DIC(391,+$GET(^DPT(PXDFN,"TYPE")),0)):1,$PIECE(^(0),"^",2):0,1:1)
- WRITE "Not a Veteran"
- QUIT
- +8 SET (SDCNT,I)=0
- +9 FOR
- SET I=$ORDER(^DPT(PXDFN,.372,I))
- if 'I
- QUIT
- IF $PIECE($GET(^(I,0)),"^",3)
- SET SDRD0=^(0)
- Begin DoDot:1
- +10 SET SDCNT=SDCNT+1
- +11 SET SDDC=$SELECT('$DATA(^DIC(31,+SDRD0,0)):"",$PIECE(^(0),"^",4)]"":$PIECE(^(0),"^",4),1:$PIECE(^(0),"^"))
- +12 if SDCNT>1
- WRITE !
- +13 WRITE ?20,$PIECE($GET(^DIC(31,+SDRD0,0)),"^",3),?25,SDDC," (",$PIECE(SDRD0,"^",2),"%-",$SELECT($PIECE(SDRD0,"^",3):"SC",1:""),")"
- End DoDot:1
- +14 IF 'SDCNT
- WRITE $SELECT('$ORDER(^DPT(PXDFN,.372,0)):"None Stated",1:"No Service Connected Disabilities Listed")
- +15 ;
- +16 QUIT