KMPDUTL8 ;OAK/RAK - CM Tools Utility ;2/17/04 10:52
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
ADD(KMPDNAME,KMPDARRY,KMPDIEN) ;-- add new entry to file #8972.1
;-----------------------------------------------------------------------
; KMPDNAME... Field #.01 (free text).
; KMPDARRY(). Array containing data to file in format (passed by value):
; KMPDARRY(FieldNumber)=InternalEntryValue.
; Example: KMPDARRY(.02)=2990719.1001
; KMPDARRY(.03)=12345
; KMPDARRY(.04)="1290"
; KMPDARRY(...)="..."
; KMPDARRY(10,1,0)="This contains word"
; KMPDARRY(10,2,0)="processing text for the"
; KMPDARRY(10,3,0)="COMMENTS field."
; KMPDIEN... New ien for entry (if not successful KMPDIEN will be null).
;-----------------------------------------------------------------------
;
Q:$G(KMPDNAME)=""
; convert disallowed characters.
S KMPDNAME=$$CONVERT^KMPDUTL7(KMPDNAME)
Q:KMPDNAME=""
;
N FDA,I,MESSAGE,ZIEN
; name.
S FDA($J,8972.1,"+1,",.01)=KMPDNAME
; additional fields.
F I=.02:.01:.09 I $G(@KMPDARRY@(I))'="" D
.S FDA($J,8972.1,"+1,",I)=@KMPDARRY@(I)
; 'comments' word-processing field.
S:$O(@KMPDARRY@(10,0)) FDA($J,8972.1,"+1,",10)=KMPDARRY_"(10)"
;
; update file 8971.1.
D UPDATE^DIE("","FDA($J)","ZIEN","MESSAGE")
S KMPDIEN=$G(ZIEN(1)) Q:'KMPDIEN
; if error message.
I $D(MESSAGE) D MSG^DIALOG("W","",60,10,"MESSAGE")
;
Q
;
EDIT(KMPDIEN,KMPDARRY) ;-- edit entry in file #8972.1
;-----------------------------------------------------------------------
; KMPDIEN... Ien for file #8972.1 (CM CODE EVALUATOR)
; KMPDARRY(). Array containing data to file in format (passed by value):
; KMPDARRY(FieldNumber)=InternalEntryValue.
; Example: KMPDARRY(.02)=2990719.1001
; KMPDARRY(.03)=12345
; KMPDARRY(.04)="1290"
; KMPDARRY(...)="..."
; KMPDARRY(10,1,0)="This contains word"
; KMPDARRY(10,2,0)="processing text for the"
; KMPDARRY(10,3,0)="COMMENTS field."
;-----------------------------------------------------------------------
;
Q:'$G(KMPDIEN)
Q:'$D(^KMPD(8972.1,+KMPDIEN,0))#5
Q:$G(KMPDARRY)=""
;
N DATA,FDA,I,MESSAGE,ZIEN
;
; data already stored for this entry
S DATA(0)=$G(^KMPD(8972.1,+KMPDIEN,0))
;
; date/time last edited
S FDA($J,8972.1,KMPDIEN_",",2.01)=$$NOW^XLFDT
;
; last edited by
S:$G(DUZ) FDA($J,8972.1,KMPDIEN_",",2.02)=DUZ
;
; add data elements to current data
F I=.04:.01:.09 D
.S FDA($J,8972.1,KMPDIEN_",",I)=@KMPDARRY@(I)+$P(DATA(0),U,(I*100))
.; make sure not negative number
.S FDA($J,8972.1,KMPDIEN_",",I)=$$NUMBER^KMPDUTL7(FDA($J,8972.1,KMPDIEN_",",I))
.; if number has grown to 15 characters or more then make this code
.; evaluator inactive
.S:$L(FDA($J,8972.1,KMPDIEN_",",I))>14 FDA($J,8971.1,KMPDIEN_",",.11)=0
;
; increment count
S FDA($J,8972.1,KMPDIEN_",",.1)=$P(DATA(0),U,10)+1
;
; 'comments' word-processing field.
S:$O(@KMPDARRY@(10,0)) FDA($J,8972.1,KMPDIEN_",",10)=KMPDARRY_"(10)"
;
; update file 8971.1.
D UPDATE^DIE("","FDA($J)","ZIEN","MESSAGE")
;
S KMPDIEN=$G(ZIEN(1)) Q:'KMPDIEN
;
; if error message.
I $D(MESSAGE) D MSG^DIALOG("W","",60,10,"MESSAGE")
;
Q
;
ID(KMPDIEN) ;-- display fields during lookup
;-----------------------------------------------------------------------
; KMPDIEN.... Ien for file #8972.1.
;-----------------------------------------------------------------------
;
Q:'$D(^KMPD(8972.1,+$G(KMPDIEN),0))
;
N DATA,TXT
S DATA=$G(^KMPD(8972.1,+KMPDIEN,0))
S TXT(1)=$$FMTE^DILIBF($P(DATA,U,2),6)
S TXT(1)=TXT(1)_" "_$$GET1^DIQ(8972.1,KMPDIEN,.03)
S TXT(1,"F")="?35"
S TXT(2)="cpu tm="_$P(DATA,U,4)_" dio ref="_$P(DATA,U,5)_" "
S TXT(2)=TXT(2)_"bio ref="_$P(DATA,U,6)_" page flts="_$P(DATA,U,7)_" "
S TXT(2)=TXT(2)_"m com="_$P(DATA,U,8)_" global ref="_$P(DATA,U,9)
S TXT(2,"F")="!?5",TXT(3)="",TXT(3,"F")="!"
D EN^DDIOL(.TXT)
;
Q
;
ELEDATA(KMPDIEN) ;-- extrinsic function - if element data
;-----------------------------------------------------------------------
; KMPDIEN... Ien for file #8972.1 (CM CODE EVALUATOR)
;
; Return: 0 - element data is NOT present
; 1 - element data is present
;-----------------------------------------------------------------------
;
Q:'$G(KMPDIEN) 0
Q:'$D(^KMPD(8972.1,+KMPDIEN,0))#5 0
;
N DATA,I,RETURN
S DATA(0)=$G(^KMPD(8972.1,+KMPDIEN,0))
S RETURN=1
F I=4,5,6,8,9 I $P(DATA(0),U,I)']"" S RETURN=0 Q
Q RETURN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDUTL8 4783 printed Oct 16, 2024@17:42:15 Page 2
KMPDUTL8 ;OAK/RAK - CM Tools Utility ;2/17/04 10:52
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
ADD(KMPDNAME,KMPDARRY,KMPDIEN) ;-- add new entry to file #8972.1
+1 ;-----------------------------------------------------------------------
+2 ; KMPDNAME... Field #.01 (free text).
+3 ; KMPDARRY(). Array containing data to file in format (passed by value):
+4 ; KMPDARRY(FieldNumber)=InternalEntryValue.
+5 ; Example: KMPDARRY(.02)=2990719.1001
+6 ; KMPDARRY(.03)=12345
+7 ; KMPDARRY(.04)="1290"
+8 ; KMPDARRY(...)="..."
+9 ; KMPDARRY(10,1,0)="This contains word"
+10 ; KMPDARRY(10,2,0)="processing text for the"
+11 ; KMPDARRY(10,3,0)="COMMENTS field."
+12 ; KMPDIEN... New ien for entry (if not successful KMPDIEN will be null).
+13 ;-----------------------------------------------------------------------
+14 ;
+15 if $GET(KMPDNAME)=""
QUIT
+16 ; convert disallowed characters.
+17 SET KMPDNAME=$$CONVERT^KMPDUTL7(KMPDNAME)
+18 if KMPDNAME=""
QUIT
+19 ;
+20 NEW FDA,I,MESSAGE,ZIEN
+21 ; name.
+22 SET FDA($JOB,8972.1,"+1,",.01)=KMPDNAME
+23 ; additional fields.
+24 FOR I=.02:.01:.09
IF $GET(@KMPDARRY@(I))'=""
Begin DoDot:1
+25 SET FDA($JOB,8972.1,"+1,",I)=@KMPDARRY@(I)
End DoDot:1
+26 ; 'comments' word-processing field.
+27 if $ORDER(@KMPDARRY@(10,0))
SET FDA($JOB,8972.1,"+1,",10)=KMPDARRY_"(10)"
+28 ;
+29 ; update file 8971.1.
+30 DO UPDATE^DIE("","FDA($J)","ZIEN","MESSAGE")
+31 SET KMPDIEN=$GET(ZIEN(1))
if 'KMPDIEN
QUIT
+32 ; if error message.
+33 IF $DATA(MESSAGE)
DO MSG^DIALOG("W","",60,10,"MESSAGE")
+34 ;
+35 QUIT
+36 ;
EDIT(KMPDIEN,KMPDARRY) ;-- edit entry in file #8972.1
+1 ;-----------------------------------------------------------------------
+2 ; KMPDIEN... Ien for file #8972.1 (CM CODE EVALUATOR)
+3 ; KMPDARRY(). Array containing data to file in format (passed by value):
+4 ; KMPDARRY(FieldNumber)=InternalEntryValue.
+5 ; Example: KMPDARRY(.02)=2990719.1001
+6 ; KMPDARRY(.03)=12345
+7 ; KMPDARRY(.04)="1290"
+8 ; KMPDARRY(...)="..."
+9 ; KMPDARRY(10,1,0)="This contains word"
+10 ; KMPDARRY(10,2,0)="processing text for the"
+11 ; KMPDARRY(10,3,0)="COMMENTS field."
+12 ;-----------------------------------------------------------------------
+13 ;
+14 if '$GET(KMPDIEN)
QUIT
+15 if '$DATA(^KMPD(8972.1,+KMPDIEN,0))#5
QUIT
+16 if $GET(KMPDARRY)=""
QUIT
+17 ;
+18 NEW DATA,FDA,I,MESSAGE,ZIEN
+19 ;
+20 ; data already stored for this entry
+21 SET DATA(0)=$GET(^KMPD(8972.1,+KMPDIEN,0))
+22 ;
+23 ; date/time last edited
+24 SET FDA($JOB,8972.1,KMPDIEN_",",2.01)=$$NOW^XLFDT
+25 ;
+26 ; last edited by
+27 if $GET(DUZ)
SET FDA($JOB,8972.1,KMPDIEN_",",2.02)=DUZ
+28 ;
+29 ; add data elements to current data
+30 FOR I=.04:.01:.09
Begin DoDot:1
+31 SET FDA($JOB,8972.1,KMPDIEN_",",I)=@KMPDARRY@(I)+$PIECE(DATA(0),U,(I*100))
+32 ; make sure not negative number
+33 SET FDA($JOB,8972.1,KMPDIEN_",",I)=$$NUMBER^KMPDUTL7(FDA($JOB,8972.1,KMPDIEN_",",I))
+34 ; if number has grown to 15 characters or more then make this code
+35 ; evaluator inactive
+36 if $LENGTH(FDA($JOB,8972.1,KMPDIEN_",",I))>14
SET FDA($JOB,8971.1,KMPDIEN_",",.11)=0
End DoDot:1
+37 ;
+38 ; increment count
+39 SET FDA($JOB,8972.1,KMPDIEN_",",.1)=$PIECE(DATA(0),U,10)+1
+40 ;
+41 ; 'comments' word-processing field.
+42 if $ORDER(@KMPDARRY@(10,0))
SET FDA($JOB,8972.1,KMPDIEN_",",10)=KMPDARRY_"(10)"
+43 ;
+44 ; update file 8971.1.
+45 DO UPDATE^DIE("","FDA($J)","ZIEN","MESSAGE")
+46 ;
+47 SET KMPDIEN=$GET(ZIEN(1))
if 'KMPDIEN
QUIT
+48 ;
+49 ; if error message.
+50 IF $DATA(MESSAGE)
DO MSG^DIALOG("W","",60,10,"MESSAGE")
+51 ;
+52 QUIT
+53 ;
ID(KMPDIEN) ;-- display fields during lookup
+1 ;-----------------------------------------------------------------------
+2 ; KMPDIEN.... Ien for file #8972.1.
+3 ;-----------------------------------------------------------------------
+4 ;
+5 if '$DATA(^KMPD(8972.1,+$GET(KMPDIEN),0))
QUIT
+6 ;
+7 NEW DATA,TXT
+8 SET DATA=$GET(^KMPD(8972.1,+KMPDIEN,0))
+9 SET TXT(1)=$$FMTE^DILIBF($PIECE(DATA,U,2),6)
+10 SET TXT(1)=TXT(1)_" "_$$GET1^DIQ(8972.1,KMPDIEN,.03)
+11 SET TXT(1,"F")="?35"
+12 SET TXT(2)="cpu tm="_$PIECE(DATA,U,4)_" dio ref="_$PIECE(DATA,U,5)_" "
+13 SET TXT(2)=TXT(2)_"bio ref="_$PIECE(DATA,U,6)_" page flts="_$PIECE(DATA,U,7)_" "
+14 SET TXT(2)=TXT(2)_"m com="_$PIECE(DATA,U,8)_" global ref="_$PIECE(DATA,U,9)
+15 SET TXT(2,"F")="!?5"
SET TXT(3)=""
SET TXT(3,"F")="!"
+16 DO EN^DDIOL(.TXT)
+17 ;
+18 QUIT
+19 ;
ELEDATA(KMPDIEN) ;-- extrinsic function - if element data
+1 ;-----------------------------------------------------------------------
+2 ; KMPDIEN... Ien for file #8972.1 (CM CODE EVALUATOR)
+3 ;
+4 ; Return: 0 - element data is NOT present
+5 ; 1 - element data is present
+6 ;-----------------------------------------------------------------------
+7 ;
+8 if '$GET(KMPDIEN)
QUIT 0
+9 if '$DATA(^KMPD(8972.1,+KMPDIEN,0))#5
QUIT 0
+10 ;
+11 NEW DATA,I,RETURN
+12 SET DATA(0)=$GET(^KMPD(8972.1,+KMPDIEN,0))
+13 SET RETURN=1
+14 FOR I=4,5,6,8,9
IF $PIECE(DATA(0),U,I)']""
SET RETURN=0
QUIT
+15 QUIT RETURN
