PXRMRPCC ;SLC/PJH - PXRM REMINDER DIALOG ;01/11/2022
;;2.0;CLINICAL REMINDERS;**6,45,65**;Feb 04, 2005;Build 438
;
; API ICR
;$$GET^XPAR 2263
;SHOWALL^YTQPXRM5 5056
;SAVECR^YTQPXRM4 4463
;NEW^WVRPCNO 4104
;
ACTIVE(ORY,ORREM) ;Check if active dialog exist for reminders
;
; input parameter ORREM is array of reminder ien [.01#811.9]
N DDIS,DIEN,OCNT,RIEN,RSTA
S OCNT=0,RIEN=0
;Get reminder ien from array
F S RIEN=$O(ORREM(RIEN)) Q:'RIEN D
.;Dialog ien for reminder
.S DIEN=$P($G(^PXD(811.9,RIEN,51)),U),RSTA=0
.;Dialog status
.I DIEN S DDIS=$P($G(^PXRMD(801.41,DIEN,0)),U,3)
.;If dialog and dialog not disabled
.I DIEN,+DDIS=0 S RSTA=1
.;Return reminder and if active dialog exists
.S OCNT=OCNT+1,ORY(OCNT)=RIEN_U_RSTA
Q
;
;
DIALOG(ORY,ORREM,DFN,VISITID) ;Load reminder dialog associated with the reminder
;
; input parameter ORREM - reminder ien [.01,#811.9]
;
S RIEN=ORREM
N DATA,DIEN
S DIEN=$G(^PXD(811.9,ORREM,51))
;
;Quit if no dialog for this reminder
I 'DIEN S ORY(1)="-1^no dialog for this reminder" Q
;
;Check if a reminder dialog and enabled
S DATA=$G(^PXRMD(801.41,DIEN,0))
;
I $P(DATA,U,4)'="R" S ORY(1)="-1^reminder dialog invalid" Q
;
I $P(DATA,U,3) S ORY(1)="-1^reminder dialog disabled" Q
;
;Load dialog lines into local array
S ORY(0)=0_U_+$P($G(^PXRMD(801.41,DIEN,0)),U,17)
D LOAD^PXRMDLL(DIEN,$G(DFN),VISITID)
Q
;
HDR(ORY,ORLOC) ;Progress Note Header by location/service/user
N ORSRV,PASS
;S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
S ORSRV=$$GET1^DIQ(200,DUZ,29,"I")
S PASS=DUZ_";VA(200,"
I +$G(ORLOC) S PASS=PASS_"^LOC.`"_ORLOC
I ORSRV>0 S PASS=PASS_"^SRV.`"_+$G(ORSRV)
S ORY=$$GET^XPAR(PASS_"^DIV^SYS^PKG","PXRM PROGRESS NOTE HEADERS",1,"Q")
Q
;
PROMPT(ORY,ORDLG,ORDCUR,ORFTYP,ORIEN,NDATA) ;Load additional prompts for a dialog element
;
; input parameters
;
; ORDLG - dialog element ien [.01,#801.41]
; ORDCUR - 0 = current, 1 = Historical for taxonomies only
; ORFTYP - finding type (CPT/POV) for taxonomies only
; ORIEN - dialog ien [.01,#801.41]
;
; These fields can be found in the output array of DIALOG^PXRMRPCC
;
D LOAD^PXRMDLLA(ORDLG,ORDCUR,$G(ORFTYP),$G(ORIEN),$G(NDATA))
Q
;
RES(ORY,ORREM) ; Reminder Resources/Inquiry
;
; input parameter ORREM - reminder ien [.01,#811.9]
;
D REMVAR^PXRMINQ(.ORY,ORREM)
Q
;
MH(ORY,OTEST) ; Mental Health dialog
;
; Input mental health instrument NAME
;
K ^TMP($J,"YSQU")
N ARRAY,CNT,CNT1,FNODE,FSUB,IC,NODE,OCNT,SUB,YS
S YS("CODE")=OTEST D SHOWALL^YTQPXRM5(.ARRAY,.YS)
S OCNT=0,CNT=0
S SUB="ARRAY",OCNT=0
F S SUB=$Q(@SUB) Q:SUB="" D
.S FSUB=$P($P(SUB,"(",2),")"),FNODE=""
.F IC=1:1 S NODE=$P(FSUB,",",IC) Q:NODE="" D
..I $E(NODE)="""" S NODE=$P(NODE,"""",2)
..S $P(FNODE,";",IC)=NODE
.Q:FNODE=""
.S OCNT=OCNT+1,ORY(OCNT)=FNODE_U_@SUB
Q
;
MHR(ORY,RESULT,ORES) ; Mental Health score and P/N text
;
; Input MH result IEN and mental health instrument response
;
D START^PXRMDLR(.ORY,RESULT,.ORES)
;
Q
;
MHS(ORY,YS) ; Mental Health save response
;
; Input mental health instrument response
N ANS,ARRAY,X
S ANS=$G(YS("R1")) K YS("R1")
S YS("ADATE")=YS("ADATE")_"."_$P($$NOW^XLFDT,".",2)
F X=1:1:$L(ANS) I $E(ANS,X)'="X" S YS(X)=X_U_$E(ANS,X)
D SAVECR^YTQPXRM4(.ARRAY,.YS)
Q
;
MST(ORY,DFN,DGMSTDT,DGMSTSC,DGMSTPR,FTYP,FIEN,RESULT) ; File MST status
;This is obsolete and can be removed when the GUI is changed not
;to use it.
Q
;
PROMPTVL(ORY,VALUE,DIEN,OVALUE,PAT) ; Calculate prompt value
N ACT,DONE,FUNC,NODE,CNT,FUNC,INPUTS,LINK,NUM,RESULT,RTN,SUB,TEMP,VAL
S CNT=0,DONE=0 F S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0!(DONE=1) D
.S LINK=$P($G(^PXRMD(801.41,DIEN,10,CNT,"LINK")),U) Q:LINK'>0
.S NODE=^PXRMD(801.48,LINK,0)
.S FUNC=$P($G(NODE),U,4) I FUNC'>0 Q
.S ACT=$P(NODE,U,5) I ACT="" Q
.;build additional inputs
.S NUM=0 F S NUM=$O(^PXRMD(801.48,LINK,2,NUM)) Q:NUM'>0 D
..S NODE=$G(^PXRMD(801.48,LINK,2,NUM,0)),SUB=$P(NODE,U),VAL=$P(NODE,U,2) Q:SUB="" Q:VAL=""
..S INPUTS(SUB)=VAL
.;AGP do we need to still check item and prompt value??
.;S RESULT="",FUNC=$P($G(NODE),U,4) I FUNC>0 D REMFUN(.RESULT,FUNC,PAT,VALUE,OVALUE)
.S RESULT="",RTN=$P($G(^PXRMD(801.47,FUNC,0)),U,2,3) Q:$P(RTN,U)="" Q:$P(RTN,U,2)=""
.S TEMP="S RET=$$"_RTN_"(.RESULT,PAT,VALUE,OVALUE,.INPUTS)"
.X TEMP
.S DONE=1
.I FUNC>0,RESULT="" Q
.;S ACT=$P(NODE,U,5) I ACT="" Q
.S ORY=$S(ACT="C":"CHECKED",ACT="S":"SUPPRESS",ACT="R":"REQUIRED",ACT="V":RESULT,ACT="UC":"UNCHECKED",ACT="US":"UNSUPPRESS",1:"")
.;S NODE=$G(^PXRMD(801.41,DIEN,10,CNT,0)) Q:LITEM'=$P(NODE,U,10) Q:LTYPE'=$P(NODE,U,11)
.;S FUNC=$G(^PXRMD(801.41,DIEN,10,CNT,1)) Q:FUNC=""
.;X FUNC S:$G(RESULT)'="" ORY=RESULT
Q
;
REMFUN(RESULT,IEN,PAT,VALUE,OVALUE) ;
N INPUTS,NODE,NUM,RTN,RET,SUB,VAL,TEMP
S RTN=$P($G(^PXRMD(801.47,IEN,0)),U,2,3) Q:$P(RTN,U)="" Q:$P(RTN,U,2)=""
S NUM=0 F S NUM=$O(^PXRMD(801.48,IEN,2,NUM)) Q:NUM'>0 D
.S NODE=$G(^PXRMD(801.48,IEN,2,NUM,0)),SUB=$P(NODE,U),VAL=$P(NODE,U,2) Q:SEQ="" Q:VAL=""
.S INPUTS(SUB)=VAL
S TEMP="S RET=$$"_RTN_"(.RESULT,PAT,VALUE,OVALUE,.INPUTS)"
X TEMP
Q
;
WH(ORY,RESULT) ;
N CNT,CNT1,CNT2,NODE,PIECNT,PUR,TYPE,TYP1,WVIEN,WVRESULT,WVNOT,WVPURIEN
N PRINT
K ^TMP("WV RPT",$J)
I '$D(RESULT) Q
S (CNT2,WVPURIEN,PUR)=0
S CNT=0 F S CNT=$O(RESULT(CNT)) Q:CNT="" D
. I $P($G(RESULT(CNT)),U)["WHIEN" D
. . S CNT2=CNT2+1
. . S WVIEN=$P($P($G(RESULT(CNT)),U),":",2),WVRESULT(CNT2)=$G(WVIEN)
. . S WVRESULT(CNT2)=WVRESULT(CNT2)_U_$P($P($G(RESULT(CNT)),U,3),":",2)
. I $P($G(RESULT(CNT)),U)["WHPur" D
. . S NODE=$G(RESULT(CNT)),PUR=$P($P($G(NODE),U),":",2)
. . S CNT1=1,TYPE=$P($G(NODE),U,2)
. . I TYPE'[":" D
...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$P($G(NODE),U,2)_U_$P($G(NODE),U,3)_U_$P($P($G(NODE),U,4),":",2)
..I TYPE[":" D
...S PIECNT=0
...F X=1:1:$L(TYPE) I $E(TYPE,X)=":" S PIECNT=PIECNT+1 I PIECNT>0 D
....S PRINT=""
....S TYP1=$P($G(TYPE),":",PIECNT)
....I TYP1="L" S PRINT=$P($G(NODE),U,3)
....S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2),CNT1=CNT1+1
...S PIECNT=PIECNT+1
...S PRINT=""
...S TYP1=$P($G(TYPE),":",PIECNT)
...I TYP1="L" S PRINT=$P($G(NODE),U,3)
...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2)
K WHMUFIND,WHFIND,WHNAME
D NEW^WVRPCNO(.WVRESULT,.WVNOT)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMRPCC 6530 printed Sep 23, 2025@19:24:56 Page 2
PXRMRPCC ;SLC/PJH - PXRM REMINDER DIALOG ;01/11/2022
+1 ;;2.0;CLINICAL REMINDERS;**6,45,65**;Feb 04, 2005;Build 438
+2 ;
+3 ; API ICR
+4 ;$$GET^XPAR 2263
+5 ;SHOWALL^YTQPXRM5 5056
+6 ;SAVECR^YTQPXRM4 4463
+7 ;NEW^WVRPCNO 4104
+8 ;
ACTIVE(ORY,ORREM) ;Check if active dialog exist for reminders
+1 ;
+2 ; input parameter ORREM is array of reminder ien [.01#811.9]
+3 NEW DDIS,DIEN,OCNT,RIEN,RSTA
+4 SET OCNT=0
SET RIEN=0
+5 ;Get reminder ien from array
+6 FOR
SET RIEN=$ORDER(ORREM(RIEN))
if 'RIEN
QUIT
Begin DoDot:1
+7 ;Dialog ien for reminder
+8 SET DIEN=$PIECE($GET(^PXD(811.9,RIEN,51)),U)
SET RSTA=0
+9 ;Dialog status
+10 IF DIEN
SET DDIS=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,3)
+11 ;If dialog and dialog not disabled
+12 IF DIEN
IF +DDIS=0
SET RSTA=1
+13 ;Return reminder and if active dialog exists
+14 SET OCNT=OCNT+1
SET ORY(OCNT)=RIEN_U_RSTA
End DoDot:1
+15 QUIT
+16 ;
+17 ;
DIALOG(ORY,ORREM,DFN,VISITID) ;Load reminder dialog associated with the reminder
+1 ;
+2 ; input parameter ORREM - reminder ien [.01,#811.9]
+3 ;
+4 SET RIEN=ORREM
+5 NEW DATA,DIEN
+6 SET DIEN=$GET(^PXD(811.9,ORREM,51))
+7 ;
+8 ;Quit if no dialog for this reminder
+9 IF 'DIEN
SET ORY(1)="-1^no dialog for this reminder"
QUIT
+10 ;
+11 ;Check if a reminder dialog and enabled
+12 SET DATA=$GET(^PXRMD(801.41,DIEN,0))
+13 ;
+14 IF $PIECE(DATA,U,4)'="R"
SET ORY(1)="-1^reminder dialog invalid"
QUIT
+15 ;
+16 IF $PIECE(DATA,U,3)
SET ORY(1)="-1^reminder dialog disabled"
QUIT
+17 ;
+18 ;Load dialog lines into local array
+19 SET ORY(0)=0_U_+$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,17)
+20 DO LOAD^PXRMDLL(DIEN,$GET(DFN),VISITID)
+21 QUIT
+22 ;
HDR(ORY,ORLOC) ;Progress Note Header by location/service/user
+1 NEW ORSRV,PASS
+2 ;S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
+3 SET ORSRV=$$GET1^DIQ(200,DUZ,29,"I")
+4 SET PASS=DUZ_";VA(200,"
+5 IF +$GET(ORLOC)
SET PASS=PASS_"^LOC.`"_ORLOC
+6 IF ORSRV>0
SET PASS=PASS_"^SRV.`"_+$GET(ORSRV)
+7 SET ORY=$$GET^XPAR(PASS_"^DIV^SYS^PKG","PXRM PROGRESS NOTE HEADERS",1,"Q")
+8 QUIT
+9 ;
PROMPT(ORY,ORDLG,ORDCUR,ORFTYP,ORIEN,NDATA) ;Load additional prompts for a dialog element
+1 ;
+2 ; input parameters
+3 ;
+4 ; ORDLG - dialog element ien [.01,#801.41]
+5 ; ORDCUR - 0 = current, 1 = Historical for taxonomies only
+6 ; ORFTYP - finding type (CPT/POV) for taxonomies only
+7 ; ORIEN - dialog ien [.01,#801.41]
+8 ;
+9 ; These fields can be found in the output array of DIALOG^PXRMRPCC
+10 ;
+11 DO LOAD^PXRMDLLA(ORDLG,ORDCUR,$GET(ORFTYP),$GET(ORIEN),$GET(NDATA))
+12 QUIT
+13 ;
RES(ORY,ORREM) ; Reminder Resources/Inquiry
+1 ;
+2 ; input parameter ORREM - reminder ien [.01,#811.9]
+3 ;
+4 DO REMVAR^PXRMINQ(.ORY,ORREM)
+5 QUIT
+6 ;
MH(ORY,OTEST) ; Mental Health dialog
+1 ;
+2 ; Input mental health instrument NAME
+3 ;
+4 KILL ^TMP($JOB,"YSQU")
+5 NEW ARRAY,CNT,CNT1,FNODE,FSUB,IC,NODE,OCNT,SUB,YS
+6 SET YS("CODE")=OTEST
DO SHOWALL^YTQPXRM5(.ARRAY,.YS)
+7 SET OCNT=0
SET CNT=0
+8 SET SUB="ARRAY"
SET OCNT=0
+9 FOR
SET SUB=$QUERY(@SUB)
if SUB=""
QUIT
Begin DoDot:1
+10 SET FSUB=$PIECE($PIECE(SUB,"(",2),")")
SET FNODE=""
+11 FOR IC=1:1
SET NODE=$PIECE(FSUB,",",IC)
if NODE=""
QUIT
Begin DoDot:2
+12 IF $EXTRACT(NODE)=""""
SET NODE=$PIECE(NODE,"""",2)
+13 SET $PIECE(FNODE,";",IC)=NODE
End DoDot:2
+14 if FNODE=""
QUIT
+15 SET OCNT=OCNT+1
SET ORY(OCNT)=FNODE_U_@SUB
End DoDot:1
+16 QUIT
+17 ;
MHR(ORY,RESULT,ORES) ; Mental Health score and P/N text
+1 ;
+2 ; Input MH result IEN and mental health instrument response
+3 ;
+4 DO START^PXRMDLR(.ORY,RESULT,.ORES)
+5 ;
+6 QUIT
+7 ;
MHS(ORY,YS) ; Mental Health save response
+1 ;
+2 ; Input mental health instrument response
+3 NEW ANS,ARRAY,X
+4 SET ANS=$GET(YS("R1"))
KILL YS("R1")
+5 SET YS("ADATE")=YS("ADATE")_"."_$PIECE($$NOW^XLFDT,".",2)
+6 FOR X=1:1:$LENGTH(ANS)
IF $EXTRACT(ANS,X)'="X"
SET YS(X)=X_U_$EXTRACT(ANS,X)
+7 DO SAVECR^YTQPXRM4(.ARRAY,.YS)
+8 QUIT
+9 ;
MST(ORY,DFN,DGMSTDT,DGMSTSC,DGMSTPR,FTYP,FIEN,RESULT) ; File MST status
+1 ;This is obsolete and can be removed when the GUI is changed not
+2 ;to use it.
+3 QUIT
+4 ;
PROMPTVL(ORY,VALUE,DIEN,OVALUE,PAT) ; Calculate prompt value
+1 NEW ACT,DONE,FUNC,NODE,CNT,FUNC,INPUTS,LINK,NUM,RESULT,RTN,SUB,TEMP,VAL
+2 SET CNT=0
SET DONE=0
FOR
SET CNT=$ORDER(^PXRMD(801.41,DIEN,10,CNT))
if CNT'>0!(DONE=1)
QUIT
Begin DoDot:1
+3 SET LINK=$PIECE($GET(^PXRMD(801.41,DIEN,10,CNT,"LINK")),U)
if LINK'>0
QUIT
+4 SET NODE=^PXRMD(801.48,LINK,0)
+5 SET FUNC=$PIECE($GET(NODE),U,4)
IF FUNC'>0
QUIT
+6 SET ACT=$PIECE(NODE,U,5)
IF ACT=""
QUIT
+7 ;build additional inputs
+8 SET NUM=0
FOR
SET NUM=$ORDER(^PXRMD(801.48,LINK,2,NUM))
if NUM'>0
QUIT
Begin DoDot:2
+9 SET NODE=$GET(^PXRMD(801.48,LINK,2,NUM,0))
SET SUB=$PIECE(NODE,U)
SET VAL=$PIECE(NODE,U,2)
if SUB=""
QUIT
if VAL=""
QUIT
+10 SET INPUTS(SUB)=VAL
End DoDot:2
+11 ;AGP do we need to still check item and prompt value??
+12 ;S RESULT="",FUNC=$P($G(NODE),U,4) I FUNC>0 D REMFUN(.RESULT,FUNC,PAT,VALUE,OVALUE)
+13 SET RESULT=""
SET RTN=$PIECE($GET(^PXRMD(801.47,FUNC,0)),U,2,3)
if $PIECE(RTN,U)=""
QUIT
if $PIECE(RTN,U,2)=""
QUIT
+14 SET TEMP="S RET=$$"_RTN_"(.RESULT,PAT,VALUE,OVALUE,.INPUTS)"
+15 XECUTE TEMP
+16 SET DONE=1
+17 IF FUNC>0
IF RESULT=""
QUIT
+18 ;S ACT=$P(NODE,U,5) I ACT="" Q
+19 SET ORY=$SELECT(ACT="C":"CHECKED",ACT="S":"SUPPRESS",ACT="R":"REQUIRED",ACT="V":RESULT,ACT="UC":"UNCHECKED",ACT="US":"UNSUPPRESS",1:"")
+20 ;S NODE=$G(^PXRMD(801.41,DIEN,10,CNT,0)) Q:LITEM'=$P(NODE,U,10) Q:LTYPE'=$P(NODE,U,11)
+21 ;S FUNC=$G(^PXRMD(801.41,DIEN,10,CNT,1)) Q:FUNC=""
+22 ;X FUNC S:$G(RESULT)'="" ORY=RESULT
End DoDot:1
+23 QUIT
+24 ;
REMFUN(RESULT,IEN,PAT,VALUE,OVALUE) ;
+1 NEW INPUTS,NODE,NUM,RTN,RET,SUB,VAL,TEMP
+2 SET RTN=$PIECE($GET(^PXRMD(801.47,IEN,0)),U,2,3)
if $PIECE(RTN,U)=""
QUIT
if $PIECE(RTN,U,2)=""
QUIT
+3 SET NUM=0
FOR
SET NUM=$ORDER(^PXRMD(801.48,IEN,2,NUM))
if NUM'>0
QUIT
Begin DoDot:1
+4 SET NODE=$GET(^PXRMD(801.48,IEN,2,NUM,0))
SET SUB=$PIECE(NODE,U)
SET VAL=$PIECE(NODE,U,2)
if SEQ=""
QUIT
if VAL=""
QUIT
+5 SET INPUTS(SUB)=VAL
End DoDot:1
+6 SET TEMP="S RET=$$"_RTN_"(.RESULT,PAT,VALUE,OVALUE,.INPUTS)"
+7 XECUTE TEMP
+8 QUIT
+9 ;
WH(ORY,RESULT) ;
+1 NEW CNT,CNT1,CNT2,NODE,PIECNT,PUR,TYPE,TYP1,WVIEN,WVRESULT,WVNOT,WVPURIEN
+2 NEW PRINT
+3 KILL ^TMP("WV RPT",$JOB)
+4 IF '$DATA(RESULT)
QUIT
+5 SET (CNT2,WVPURIEN,PUR)=0
+6 SET CNT=0
FOR
SET CNT=$ORDER(RESULT(CNT))
if CNT=""
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(RESULT(CNT)),U)["WHIEN"
Begin DoDot:2
+8 SET CNT2=CNT2+1
+9 SET WVIEN=$PIECE($PIECE($GET(RESULT(CNT)),U),":",2)
SET WVRESULT(CNT2)=$GET(WVIEN)
+10 SET WVRESULT(CNT2)=WVRESULT(CNT2)_U_$PIECE($PIECE($GET(RESULT(CNT)),U,3),":",2)
End DoDot:2
+11 IF $PIECE($GET(RESULT(CNT)),U)["WHPur"
Begin DoDot:2
+12 SET NODE=$GET(RESULT(CNT))
SET PUR=$PIECE($PIECE($GET(NODE),U),":",2)
+13 SET CNT1=1
SET TYPE=$PIECE($GET(NODE),U,2)
+14 IF TYPE'[":"
Begin DoDot:3
+15 SET WVNOT(PUR,CNT1)=$PIECE($GET(NODE),U,5)_U_$PIECE($GET(NODE),U,2)_U_$PIECE($GET(NODE),U,3)_U_$PIECE($PIECE($GET(NODE),U,4),":",2)
End DoDot:3
+16 IF TYPE[":"
Begin DoDot:3
+17 SET PIECNT=0
+18 FOR X=1:1:$LENGTH(TYPE)
IF $EXTRACT(TYPE,X)=":"
SET PIECNT=PIECNT+1
IF PIECNT>0
Begin DoDot:4
+19 SET PRINT=""
+20 SET TYP1=$PIECE($GET(TYPE),":",PIECNT)
+21 IF TYP1="L"
SET PRINT=$PIECE($GET(NODE),U,3)
+22 SET WVNOT(PUR,CNT1)=$PIECE($GET(NODE),U,5)_U_$GET(TYP1)_U_$GET(PRINT)_U_$PIECE($PIECE($GET(NODE),U,4),":",2)
SET CNT1=CNT1+1
End DoDot:4
+23 SET PIECNT=PIECNT+1
+24 SET PRINT=""
+25 SET TYP1=$PIECE($GET(TYPE),":",PIECNT)
+26 IF TYP1="L"
SET PRINT=$PIECE($GET(NODE),U,3)
+27 SET WVNOT(PUR,CNT1)=$PIECE($GET(NODE),U,5)_U_$GET(TYP1)_U_$GET(PRINT)_U_$PIECE($PIECE($GET(NODE),U,4),":",2)
End DoDot:3
End DoDot:2
End DoDot:1
+28 KILL WHMUFIND,WHFIND,WHNAME
+29 DO NEW^WVRPCNO(.WVRESULT,.WVNOT)
+30 QUIT
+31 ;
