- 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 Feb 19, 2025@00:21:47 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 ;
