PRCPSMS0 ;WISC/RFJ-isms trans, build segments: control, line count ;21 Oct 91
;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
;
CONTROL(V1,V2,V3) ; build control segment
; v1=station number, v2=transaction code, v3=reference number
; returns 'string' of segment
I 'V1!(V2="") S STRING="" Q
N %,%H,%I,DATE,NOW,TIME,X,Y
D NOW^%DTC S NOW=%,Y=%_"000000" D DD^%DT S TIME=$TR($P(Y,"@",2),":"),X1=$P(NOW,"."),X2=$E(NOW,1,3)_"0101" D ^%DTC S X=X+1,X=$E("000",$L(X)+1,3)_X,DATE=($E(NOW)+17)_$E(NOW,2,3)_X
S V3=V3_$E(" ",$L(V3)+1,11)
S STRING="ISM^"_V1_"^^"_V2_"^"_DATE_"^"_TIME_"^"_V3_"^001^001^040^|"
Q
;
;
LINECNT(V1,V2) ; line count segment
; v1=line count, v2=reference number
; returns 'string("lc")' of data
I $L(V1)>3!($L(V2)>11) S STRING("LC")="" Q
S STRING("LC")="LC^"_V1_"^"_V2_"^|"
Q
;
;
DELETE(DATA) ; delete segment
; data=itemda
; returns 'string("id")' of data
N NSN S NSN=$$NSN^PRCPUX1(DATA) I NSN="" S STRING("ID")="" Q
S STRING("ID")="ID^"_$TR(NSN,"-")_"^|"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPSMS0 1096 printed Nov 22, 2024@17:26:03 Page 2
PRCPSMS0 ;WISC/RFJ-isms trans, build segments: control, line count ;21 Oct 91
+1 ;;5.1;IFCAP;;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
CONTROL(V1,V2,V3) ; build control segment
+1 ; v1=station number, v2=transaction code, v3=reference number
+2 ; returns 'string' of segment
+3 IF 'V1!(V2="")
SET STRING=""
QUIT
+4 NEW %,%H,%I,DATE,NOW,TIME,X,Y
+5 DO NOW^%DTC
SET NOW=%
SET Y=%_"000000"
DO DD^%DT
SET TIME=$TRANSLATE($PIECE(Y,"@",2),":")
SET X1=$PIECE(NOW,".")
SET X2=$EXTRACT(NOW,1,3)_"0101"
DO ^%DTC
SET X=X+1
SET X=$EXTRACT("000",$LENGTH(X)+1,3)_X
SET DATE=($EXTRACT(NOW)+17)_$EXTRACT(NOW,2,3)_X
+6 SET V3=V3_$EXTRACT(" ",$LENGTH(V3)+1,11)
+7 SET STRING="ISM^"_V1_"^^"_V2_"^"_DATE_"^"_TIME_"^"_V3_"^001^001^040^|"
+8 QUIT
+9 ;
+10 ;
LINECNT(V1,V2) ; line count segment
+1 ; v1=line count, v2=reference number
+2 ; returns 'string("lc")' of data
+3 IF $LENGTH(V1)>3!($LENGTH(V2)>11)
SET STRING("LC")=""
QUIT
+4 SET STRING("LC")="LC^"_V1_"^"_V2_"^|"
+5 QUIT
+6 ;
+7 ;
DELETE(DATA) ; delete segment
+1 ; data=itemda
+2 ; returns 'string("id")' of data
+3 NEW NSN
SET NSN=$$NSN^PRCPUX1(DATA)
IF NSN=""
SET STRING("ID")=""
QUIT
+4 SET STRING("ID")="ID^"_$TRANSLATE(NSN,"-")_"^|"
+5 QUIT
