DGRP6CL2 ;ALB/TMK - REGISTRATION SCREEN 6 FLDS Conflict loc (cont) ; 09/15/2005
;;5.3;Registration;**689**;Aug 13, 1993;Build 1
;
ISVALID(DGCONF,DGPOSS) ; Configure delimiter for edit/no edit
; DGCONF = the conflict location or location multiple entry
; DGCONF(DGCONF) is the array returned from CLLST^DGRP6CL call
; DGPOSS(DGCONF) is the array returned from CLLST^DGRP6CL call
; Assume DFN exists
;
; RETURNS:
; DGCONF(DGCONF,"NOEDIT"))=1 if data is locked (no editing of HEC data or if VIEW only)
; DGCONF(DGCONF,"VEDIT"))=1 if the data is valid for entry/edit
; =2 if data valid but only for edit/delete
; Function returns either [] for editable or <> for not editable.
;
N DG,Z,DGCONF1,DGLOCK
S DGLOCK=$S('$G(DGRPVV(6,"NOEDIT")):+$P(DGCONF(DGCONF),U,4),1:1)
S DGCONF1=$E(DGCONF,1,3)
I DGLOCK S DGCONF(DGCONF,"NOEDIT")=1
I $G(DGCONF(DGCONF))'=""!$D(DGPOSS(DGCONF)) D
. Q:DGCONF1="UNK"!DGLOCK ; Never editable
. I DGCONF="OEF"!(DGCONF="OIF")!$D(DGPOSS(DGCONF)) S DGCONF(DGCONF,"VEDIT")=$S('$G(DGCONF(DGCONF,1)):1,1:2)
. I "^OEF^OIF^"[(U_DGCONF1_U) D:DGCONF=DGCONF1&($G(DGCONF(DGCONF,"VEDIT"))=2) Q
.. N OK
.. Q:$G(DGCONF(DGCONF,"VEDIT"))'=2
.. S OK=0
.. S Z=DGCONF F S Z=$O(DGCONF(Z)) Q:Z=""!($E(Z,1,3)'=$E(DGCONF,1,3)) I '$P($G(DGCONF(Z)),U,4) S OK=1 Q
.. I 'OK S DGCONF(DGCONF,"NOEDIT")=1 K DGCONF(DGCONF,"VEDIT")
. ;
. S DGCONF(DGCONF,"VEDIT")=$S('$G(DGCONF(DGCONF,1)):1,1:2)
;
I '$G(DGCONF(DGCONF,"VEDIT")),'DGLOCK D
. I $S(DGCONF1="OEF"!(DGCONF1="OIF")!(DGCONF1="UNK"):0,1:1) D Q
.. S DG=$S(DGCONF="VIET":$G(^DPT(DFN,.321)),1:$G(^DPT(DFN,.322)))
.. I "NO"'[$TR($$YN(DG,$S(DGCONF="VIET":6,DGCONF="LEB":1,DGCONF="GREN":4,DGCONF="PAN":7,DGCONF="GULF":10,DGCONF="SOM":16,DGCONF="YUG":19,1:""))," ") S DGCONF(DGCONF,"VEDIT")=$S('$G(DGCONF(DGCONF,1)):1,1:2) Q
.. S DGCONF(DGCONF,"NOEDIT")=1 ;,DGCONF(DGCONF,1)=1
Q $S($G(DGCONF(DGCONF,"VEDIT")):"[]",1:"<>")
;
YN(DGRPX,X) ;Format Yes/No fld in $P(DGRPX,U,X)
;
Q $S($P(DGRPX,"^",X)="Y":"YES",$P(DGRPX,"^",X)="N":"NO ",$P(DGRPX,"^",X)="U":"UNK",1:" ")
;
CL(DFN,LIN) ; Format conflict locations on file for the pt
N DGCONF,DGCONFX,DGLIM,DGOEIF,DGCT,Z,Z0,Z1,Z2,Z3
K LIN
S (DGLIM,DGCT,LIN)=0,LIN(0)=0
F Z="OEF","OIF","UNK" S LIN(Z)=0
D CLLST^DGRP6CL(DFN,.DGCONF,"")
; Make OEF/OIF/ UNKNOWN OEF/OIF display in reverse date order
; within conflict & only display the first 4 of all the vet's conflicts
; with data
S Z2=0
F Z0="OEF","OIF","UNK" S Z1=Z0,Z2=Z2+1 I $D(DGCONF(Z0)) M DGCONF(Z2_Z0)=DGCONF(Z0) F S Z1=$O(DGCONF(Z1)) Q:Z1=""!(Z1'[Z0) I DGCONF(Z1) M DGCONF(Z2_Z0_"-"_(9999999-$P(DGCONF(Z1),U)))=DGCONF(Z1) K DGCONF(Z1)
S DGCONF="" F S DGCONF=$O(DGCONF(DGCONF)) Q:DGCONF="" S DGCONFX=$S($E(DGCONF)?1N:$E(DGCONF,2,$L(DGCONF)),1:DGCONF) I DGCONF(DGCONF)'=""!$D(DGPOSS(DGCONFX)) D I DGCT=5 S DGLIM=1 Q
. S Z3=$E(DGCONFX,1,3)
. S Z0=$S(Z3'="UNK":Z3,1:"UNK OEF/OIF"),DGOEIF=$S(Z3="OEF"!(Z3="OIF")!(Z3="UNK"):1,1:0)
. I DGOEIF Q:DGCONFX'["-"
. I DGOEIF D
.. S LIN=LIN+1,LIN(Z3)=LIN(Z3)+1,LIN(LIN)=Z0
. E D
.. S LIN=LIN+1,LIN(LIN)=$S(DGCONFX="VIET":"Vietnam",DGCONFX="LEB":"Lebanon",DGCONFX="GREN":"Grenada",DGCONFX="PAN":"Panama",DGCONFX="GULF":"Gulf War",DGCONFX="SOM":"Somalia",DGCONFX="YUG":"Yugoslavia",1:"")
. S DGCT=DGCT+1
. I $L(LIN(LIN))>LIN(0) S LIN(0)=$L(LIN(LIN))
. S LIN(LIN,1)="("_$S($P(DGCONF(DGCONF),U):$$FMTE^XLFDT($P(DGCONF(DGCONF),U),"5DZ"),1:"date missing")_"-"_$S($P(DGCONF(DGCONF),U,2):$$FMTE^XLFDT($P(DGCONF(DGCONF),U,2),"5DZ"),1:"date missing")_") "
. S LIN(LIN,1)=$E(LIN(LIN,1)_$J("",25),1,25)
. S LIN(LIN,1)=LIN(LIN,1)_$S($G(DGCONF(DGCONF,1))=1:"**Not Within MSE",1:"")
S:'LIN(0) LIN(0)=25
S Z0=0 F S Z0=$O(LIN(Z0)) Q:'Z0 S LIN(Z0)=$E(LIN(Z0)_$J("",LIN(0)),1,LIN(0))_LIN(Z0,1) K LIN(Z0,1)
I DGLIM S LIN(LIN)="++Additional Conflict Locations exist for this patient"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRP6CL2 3917 printed Oct 16, 2024@18:56:18 Page 2
DGRP6CL2 ;ALB/TMK - REGISTRATION SCREEN 6 FLDS Conflict loc (cont) ; 09/15/2005
+1 ;;5.3;Registration;**689**;Aug 13, 1993;Build 1
+2 ;
ISVALID(DGCONF,DGPOSS) ; Configure delimiter for edit/no edit
+1 ; DGCONF = the conflict location or location multiple entry
+2 ; DGCONF(DGCONF) is the array returned from CLLST^DGRP6CL call
+3 ; DGPOSS(DGCONF) is the array returned from CLLST^DGRP6CL call
+4 ; Assume DFN exists
+5 ;
+6 ; RETURNS:
+7 ; DGCONF(DGCONF,"NOEDIT"))=1 if data is locked (no editing of HEC data or if VIEW only)
+8 ; DGCONF(DGCONF,"VEDIT"))=1 if the data is valid for entry/edit
+9 ; =2 if data valid but only for edit/delete
+10 ; Function returns either [] for editable or <> for not editable.
+11 ;
+12 NEW DG,Z,DGCONF1,DGLOCK
+13 SET DGLOCK=$SELECT('$GET(DGRPVV(6,"NOEDIT")):+$PIECE(DGCONF(DGCONF),U,4),1:1)
+14 SET DGCONF1=$EXTRACT(DGCONF,1,3)
+15 IF DGLOCK
SET DGCONF(DGCONF,"NOEDIT")=1
+16 IF $GET(DGCONF(DGCONF))'=""!$DATA(DGPOSS(DGCONF))
Begin DoDot:1
+17 ; Never editable
if DGCONF1="UNK"!DGLOCK
QUIT
+18 IF DGCONF="OEF"!(DGCONF="OIF")!$DATA(DGPOSS(DGCONF))
SET DGCONF(DGCONF,"VEDIT")=$SELECT('$GET(DGCONF(DGCONF,1)):1,1:2)
+19 IF "^OEF^OIF^"[(U_DGCONF1_U)
if DGCONF=DGCONF1&($GET(DGCONF(DGCONF,"VEDIT"))=2)
Begin DoDot:2
+20 NEW OK
+21 if $GET(DGCONF(DGCONF,"VEDIT"))'=2
QUIT
+22 SET OK=0
+23 SET Z=DGCONF
FOR
SET Z=$ORDER(DGCONF(Z))
if Z=""!($EXTRACT(Z,1,3)'=$EXTRACT(DGCONF,1,3))
QUIT
IF '$PIECE($GET(DGCONF(Z)),U,4)
SET OK=1
QUIT
+24 IF 'OK
SET DGCONF(DGCONF,"NOEDIT")=1
KILL DGCONF(DGCONF,"VEDIT")
End DoDot:2
QUIT
+25 ;
+26 SET DGCONF(DGCONF,"VEDIT")=$SELECT('$GET(DGCONF(DGCONF,1)):1,1:2)
End DoDot:1
+27 ;
+28 IF '$GET(DGCONF(DGCONF,"VEDIT"))
IF 'DGLOCK
Begin DoDot:1
+29 IF $SELECT(DGCONF1="OEF"!(DGCONF1="OIF")!(DGCONF1="UNK"):0,1:1)
Begin DoDot:2
+30 SET DG=$SELECT(DGCONF="VIET":$GET(^DPT(DFN,.321)),1:$GET(^DPT(DFN,.322)))
+31 IF "NO"'[$TRANSLATE($$YN(DG,$SELECT(DGCONF="VIET":6,DGCONF="LEB":1,DGCONF="GREN":4,DGCONF="PAN":7,DGCONF="GULF":10,DGCONF="SOM":16,DGCONF="YUG":19,1:""))," ")
SET DGCONF(DGCONF,"VEDIT")=$SELECT('$GET(DGCONF(DGCONF,1)):1,1:2)
QUIT
+32 ;,DGCONF(DGCONF,1)=1
SET DGCONF(DGCONF,"NOEDIT")=1
End DoDot:2
QUIT
End DoDot:1
+33 QUIT $SELECT($GET(DGCONF(DGCONF,"VEDIT")):"[]",1:"<>")
+34 ;
YN(DGRPX,X) ;Format Yes/No fld in $P(DGRPX,U,X)
+1 ;
+2 QUIT $SELECT($PIECE(DGRPX,"^",X)="Y":"YES",$PIECE(DGRPX,"^",X)="N":"NO ",$PIECE(DGRPX,"^",X)="U":"UNK",1:" ")
+3 ;
CL(DFN,LIN) ; Format conflict locations on file for the pt
+1 NEW DGCONF,DGCONFX,DGLIM,DGOEIF,DGCT,Z,Z0,Z1,Z2,Z3
+2 KILL LIN
+3 SET (DGLIM,DGCT,LIN)=0
SET LIN(0)=0
+4 FOR Z="OEF","OIF","UNK"
SET LIN(Z)=0
+5 DO CLLST^DGRP6CL(DFN,.DGCONF,"")
+6 ; Make OEF/OIF/ UNKNOWN OEF/OIF display in reverse date order
+7 ; within conflict & only display the first 4 of all the vet's conflicts
+8 ; with data
+9 SET Z2=0
+10 FOR Z0="OEF","OIF","UNK"
SET Z1=Z0
SET Z2=Z2+1
IF $DATA(DGCONF(Z0))
MERGE DGCONF(Z2_Z0)=DGCONF(Z0)
FOR
SET Z1=$ORDER(DGCONF(Z1))
if Z1=""!(Z1'[Z0)
QUIT
IF DGCONF(Z1)
MERGE DGCONF(Z2_Z0_"-"_(9999999-$PIECE(DGCONF(Z1),U)))=DGCONF(Z1)
KILL DGCONF(Z1)
+11 SET DGCONF=""
FOR
SET DGCONF=$ORDER(DGCONF(DGCONF))
if DGCONF=""
QUIT
SET DGCONFX=$SELECT($EXTRACT(DGCONF)?1N:$EXTRACT(DGCONF,2,$LENGTH(DGCONF)),1:DGCONF)
IF DGCONF(DGCONF)'=""!$DATA(DGPOSS(DGCONFX))
Begin DoDot:1
+12 SET Z3=$EXTRACT(DGCONFX,1,3)
+13 SET Z0=$SELECT(Z3'="UNK":Z3,1:"UNK OEF/OIF")
SET DGOEIF=$SELECT(Z3="OEF"!(Z3="OIF")!(Z3="UNK"):1,1:0)
+14 IF DGOEIF
if DGCONFX'["-"
QUIT
+15 IF DGOEIF
Begin DoDot:2
+16 SET LIN=LIN+1
SET LIN(Z3)=LIN(Z3)+1
SET LIN(LIN)=Z0
End DoDot:2
+17 IF '$TEST
Begin DoDot:2
+18 SET LIN=LIN+1
SET LIN(LIN)=$SELECT(DGCONFX="VIET":"Vietnam",DGCONFX="LEB":"Lebanon",DGCONFX="GREN":"Grenada",DGCONFX="PAN":"Panama",DGCONFX="GULF":"Gulf War",DGCONFX="SOM":"Somalia",DGCONFX="YUG":"Yugoslavia",1:"")
End DoDot:2
+19 SET DGCT=DGCT+1
+20 IF $LENGTH(LIN(LIN))>LIN(0)
SET LIN(0)=$LENGTH(LIN(LIN))
+21 SET LIN(LIN,1)="("_$SELECT($PIECE(DGCONF(DGCONF),U):$$FMTE^XLFDT($PIECE(DGCONF(DGCONF),U),"5DZ"),1:"date missing")_"-"_$SELECT($PIECE(DGCONF(DGCONF),U,2):$$FMTE^XLFDT($PIECE(DGCONF(DGCONF),U,2),"5DZ"),1:"date missing")_") "
+22 SET LIN(LIN,1)=$EXTRACT(LIN(LIN,1)_$JUSTIFY("",25),1,25)
+23 SET LIN(LIN,1)=LIN(LIN,1)_$SELECT($GET(DGCONF(DGCONF,1))=1:"**Not Within MSE",1:"")
End DoDot:1
IF DGCT=5
SET DGLIM=1
QUIT
+24 if 'LIN(0)
SET LIN(0)=25
+25 SET Z0=0
FOR
SET Z0=$ORDER(LIN(Z0))
if 'Z0
QUIT
SET LIN(Z0)=$EXTRACT(LIN(Z0)_$JUSTIFY("",LIN(0)),1,LIN(0))_LIN(Z0,1)
KILL LIN(Z0,1)
+26 IF DGLIM
SET LIN(LIN)="++Additional Conflict Locations exist for this patient"
+27 QUIT
+28 ;
