ORWLRAP2 ;SLC/JNM - ANATOMIC PATHOLOGY DIALOG SUPPORT ROUTINES ;Jul 13, 2022@08:14:55
;;3.0;ORDER ENTRY/RESULTS REPORTING;**569**;Dec 17, 1997;Build 23
Q
GETDLGIEN() ; Returns the 101.45 IEN for the current quick order
N IEN,APIDX,OI
S IEN=0,APIDX=$P($G(ORDIALOG("B","ANATOMIC PATHOLOGY TEST")),U,2)
I APIDX S OI=$P($G(ORDIALOG(APIDX,1)),U) I OI S IEN=$O(^ORD(101.45,"C",OI,0))
Q IEN
;
ASKPROMPT(PROMPTID) ; Allow prompt selection in quick order
; PROMPTID:
; OPURG:URGENCY
; OPCDT:COLLECTION DATE/TIME
; OPSSB:SPECIMEN SUBMITTED BY
; OPCTY:COLLECTION TYPE
; OPHOF:HOW OFTEN
; OPSPH:SURGEON/PROVIDER
; OPODC:ORDER COMMENT
N OK,IEN,PIDX
I "^OPURG^OPCDT^OPSSB^OPCTY^OPHOF^OPSPH^OPODC^"'[(U_$G(PROMPTID)_U) Q 0
S OK=1,IEN=$$GETDLGIEN
I 'IEN S OK=0
E D
. S PIDX=$O(^ORD(101.45,IEN,1,"B",PROMPTID,0))
. I PIDX,$P($G(^ORD(101.45,IEN,1,PIDX,0)),U,2) S OK=0
Q OK
;
GETPAGECODES(CODE) ;
S CODE(1)="Clinical History^CLINHX"
S CODE(2)="Pre-Operative Diagnosis^PREOPDX"
S CODE(3)="Operative Findings^OPFIND"
S CODE(4)="Post-Operative Findings^POSTOPDX"
Q
;
ASKPAGE(PAGEID) ; Allow page selection in quick order
N OK,IEN,IDX,PAGE,CODE,FOUND
D GETPAGECODES(.CODE)
S (IDX,FOUND)=0 F S IDX=$O(CODE(IDX)) Q:'IDX D Q:FOUND
. I PAGEID=$P(CODE(IDX),U,2) S FOUND=1
I 'FOUND Q 0
S OK=0,IEN=$$GETDLGIEN I IEN D
. S IDX=0 F S IDX=$O(^ORD(101.45,IEN,2,IDX)) Q:'IDX D Q:OK
. . S PAGE=$G(^ORD(101.45,IEN,2,IDX,0))
. . I $P(PAGE,U,5)=PAGEID,'$P(PAGE,U,3) S OK=1
Q OK
;
ALLOWSPEC(SPEC) ; Allow specimens
N IEN,OK
S OK=0,IEN=$$GETDLGIEN
I IEN D
. I $P($G(^ORD(101.45,IEN,0)),U,2) S OK=1
. E I +$O(^ORD(101.45,IEN,3,"B",SPEC,0)) S OK=1
Q OK
;
GETCOUNT(IDX) ; Get the count of the spcific prompt
N COUNT,I
S (COUNT,I)=0
F S I=$O(ORDIALOG(IDX,I)) Q:'I S COUNT=COUNT+1
Q COUNT
;
SHOWCOUNT(COUNT,DESC) ; Show count line
N SS,ZMSG S SS=$S(COUNT=1:"",1:"s"),ZMSG=""
I COUNT<1 S COUNT="No",ZMSG=" (must have at lease one)"
W " *** "_COUNT_" "_DESC_SS_" found"_ZMSG_".",?SIZE,"***",!
Q
;
ISINVALID() ; Validate AP Dialog quick order before saving
N INVALID,IDX,SIZE,SAMPIDX,SPECIDX,DESCIDX,SAMPCOUNT,SPECCOUNT,DESCCOUNT
S INVALID=1 D
. S SAMPIDX=$P($G(ORDIALOG("B","COLLECTION SAMPLE")),U,2) Q:'SAMPIDX
. S SPECIDX=$P($G(ORDIALOG("B","SPECIMEN")),U,2) Q:'SPECIDX
. S DESCIDX=$P($G(ORDIALOG("B","SPECIMEN DESCRIPTION")),U,2) Q:'DESCIDX
. S INVALID=0
I 'INVALID D
. S SAMPCOUNT=$$GETCOUNT(SAMPIDX)
. S SPECCOUNT=$$GETCOUNT(SPECIDX)
. S DESCCOUNT=$$GETCOUNT(DESCIDX)
. I (SAMPCOUNT<1)!(SAMPCOUNT'=SPECCOUNT)!(SAMPCOUNT'=DESCCOUNT) D
. . S INVALID=1,SIZE=69
. . W !,$C(7)," "_$$REPEAT^XLFSTR("*",SIZE+2),!
. . W " *** Anatomic Pathology Quick Order is not valid!",?SIZE,"***",!
. . W " ***",?SIZE,"***",!
. . D SHOWCOUNT(SAMPCOUNT,"Collection Sample")
. . D SHOWCOUNT(SPECCOUNT,"Specimen")
. . D SHOWCOUNT(DESCCOUNT,"Specimen Description")
. . W " ***",?SIZE,"***",!
. . W " *** The same number of Collection Samples, Specimens",?SIZE,"***",!
. . W " *** and Specimen Descriptions are required!",?SIZE,"***",!
. . W " "_$$REPEAT^XLFSTR("*",SIZE+2),!
Q INVALID
;
PROMPTINFO(TYPE) ; Returns item info from the LR OTHER LAB AP TESTS order dialog
; Return Data = AP Dlg IEN^Item Multiple IEN^Child Dlg IEN
N ASKCODE,APDLG,DATA,IDX,X0,DONE,ITEM
Q:$G(TYPE)="" ""
S ASKCODE="$$ASKPROMPT^ORWLRAP2("""_TYPE_""")"
S DATA="",APDLG=$O(^ORD(101.41,"B","LR OTHER LAB AP TESTS",0)) Q:'APDLG ""
S (DONE,IDX)=0 F S IDX=$O(^ORD(101.41,APDLG,10,IDX)) Q:DONE!('IDX) D
. I $G(^ORD(101.41,APDLG,10,IDX,3))[ASKCODE D S DONE=1
. . S X0=$G(^ORD(101.41,APDLG,10,IDX,0)),ITEM=$P(X0,U,2)
. . S DATA=APDLG_U_IDX_U_ITEM
Q DATA
;
ISTEXT(LABIEN,PROMPTIEN) ;
N TYPE,ITEM
S TYPE=$P($G(^ORD(101.45,LABIEN,1,PROMPTIEN,0)),U)
S ITEM=$P($$PROMPTINFO(TYPE),U,3)
I +ITEM,"^S^P^R^"'[(U_$P($G(^ORD(101.41,ITEM,1)),U)_U) Q 1
Q 0
;
OK2DELETE(DEFAULT) ;
N OK
S OK=0
I DEFAULT'="" D
. N DIR,DA,X,Y,DIRUT
. S DIR(0)="YAO",DIR("A")=" SURE YOU WANT TO DELETE? "
. D ^DIR
. I Y=1 S OK=1
. E W " <NOTHING DELETED>"
Q OK
;
GETDEFAULT(LABIEN,PROMPTIEN) ; Used by Input Template OR AP DIALOG EDIT TEMPLATE
N REC,TYPE,DEFAULT,INFO,APDLG,IDX,ITEM,X1,PRTYPE,HELP
N DIR,DA,X,Y,DIRUT,DONE
S REC=$G(^ORD(101.45,LABIEN,1,PROMPTIEN,0))
S TYPE=$P(REC,U),DEFAULT=$P(REC,U,4) Q:TYPE="" DEFAULT
S INFO=$$PROMPTINFO(TYPE) Q:INFO="" DEFAULT
S APDLG=$P(INFO,U,1),IDX=$P(INFO,U,2),ITEM=$P(INFO,U,3)
S X1=$G(^ORD(101.41,ITEM,1)),PRTYPE=$P(X1,U,1),HELP=$P($G(^ORD(101.41,APDLG,10,IDX,1)),U,1)
S DIR("A")=" DEFAULT: "
I HELP'="" S DIR("?")=HELP
I PRTYPE="P" D I 1 ; Pointer Type
. N FILE,VAL
. S FILE=+$P(X1,U,2),DIR(0)="PAOr^"_FILE_":AEQM"
. I +DEFAULT D EXTNAME^ORWU(.VAL,+DEFAULT,FILE) S:VAL'="" DIR("B")=VAL
. F S DONE=1 D Q:DONE
. . D ^DIR I $G(X)="@" D I 1
. . . S DONE=$$OK2DELETE(DEFAULT)
. . . I DONE S DEFAULT="@"
. . E I '$D(DIRUT),+Y>0 S DEFAULT=+Y
E I PRTYPE="S" D I 1 ; Set of Codes
. N CODES,P1,P2
. S CODES=$P(X1,U,2),DIR(0)="SAO^"_CODES
. I DEFAULT'="" D
. . S P1=$F(CODES,DEFAULT_":")
. . I P1 D I 1
. . . S P2=$F(CODES,";",P1) I 'P2 S P2=$L(CODES)+2
. . . S DIR("B")=$E(CODES,P1,P2-2)
. . E S DEFAULT="@" ; Code not found
. F S DONE=1 D Q:DONE
. . D ^DIR I $G(X)="@" D I 1
. . . S DONE=$$OK2DELETE(DEFAULT)
. . . I DONE S DEFAULT="@"
. . E I '$D(DIRUT),Y'="" S DEFAULT=Y
E I PRTYPE="R" D I 1 ; Free Text Date/Time
. S DIR(0)="DAO^::ET"
. I DEFAULT'="" S DIR("B")=DEFAULT
. F S DONE=1 D Q:DONE
. . D ^DIR I $G(X)="@" D I 1
. . . S DONE=$$OK2DELETE(DEFAULT)
. . . I DONE S DEFAULT="@"
. . E I '$D(DIRUT),Y>0 S DEFAULT=X
Q DEFAULT
;
GETPAGEID(LABIEN,PAGEIEN) ; Used by Input Template OR AP DIALOG EDIT TEMPLATE
N REC,NAME,TYPE,DEFAULT,DIR,DA,X,Y,DIRUT,DONE,CODE,IDX,IEN,USEDTYPE,FIRST
S REC=$G(^ORD(101.45,LABIEN,2,PAGEIEN,0))
S NAME=$P(REC,U,2),TYPE=$P(REC,U,5)
D GETPAGECODES(.CODE)
S IEN=0 F S IEN=$O(^ORD(101.45,LABIEN,2,IEN)) Q:'IEN D:IEN'=PAGEIEN
. S USEDTYPE=$P($G(^ORD(101.45,LABIEN,2,IEN,0)),U,5)
. I USEDTYPE'="" D
. . S (DONE,IDX)=0 F S IDX=$O(CODE(IDX)) Q:'IDX D Q:DONE
. . . I USEDTYPE=$P(CODE(IDX),U,2) K CODE(IDX) S DONE=1
S DIR(0)="SA^",DIR("A")=" PAGE TYPE: ",DEFAULT=""
S DIR("?")="Enter the type of page (types already used have been removed)."
S IDX=0,FIRST=1 F S IDX=$O(CODE(IDX)) Q:'IDX D
. S DIR(0)=DIR(0)_$S(FIRST:"",1:";")_IDX_":"_$P(CODE(IDX),U),FIRST=0
I TYPE'="" D
. S (IDX,DONE)=0 F S IDX=$O(CODE(IDX)) Q:'IDX D Q:DONE
. . I TYPE=$P(CODE(IDX),U,2) S DIR("B")=$P(CODE(IDX),U),DEFAULT=TYPE,DONE=1
D ^DIR
I '$D(DIRUT),+Y>0 S DEFAULT=$P($G(CODE(+Y)),U,2)
Q DEFAULT
;
GETPAGENAME(LABIEN,PAGEIEN,TYPE) ; Used by Input Template OR AP DIALOG EDIT TEMPLATE
N NAME,CODE,IDX,DONE
S NAME=$P($G(^ORD(101.45,LABIEN,2,PAGEIEN,0)),U,2)
I NAME="",TYPE'="" D
. D GETPAGECODES(.CODE)
. S (IDX,DONE)=0 F S IDX=$O(CODE(IDX)) Q:'IDX D Q:DONE
. . I TYPE=$P(CODE(IDX),U,2) S NAME=$P(CODE(IDX),U),DONE=1
Q NAME
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWLRAP2 7167 printed Dec 13, 2024@02:36:41 Page 2
ORWLRAP2 ;SLC/JNM - ANATOMIC PATHOLOGY DIALOG SUPPORT ROUTINES ;Jul 13, 2022@08:14:55
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**569**;Dec 17, 1997;Build 23
+2 QUIT
GETDLGIEN() ; Returns the 101.45 IEN for the current quick order
+1 NEW IEN,APIDX,OI
+2 SET IEN=0
SET APIDX=$PIECE($GET(ORDIALOG("B","ANATOMIC PATHOLOGY TEST")),U,2)
+3 IF APIDX
SET OI=$PIECE($GET(ORDIALOG(APIDX,1)),U)
IF OI
SET IEN=$ORDER(^ORD(101.45,"C",OI,0))
+4 QUIT IEN
+5 ;
ASKPROMPT(PROMPTID) ; Allow prompt selection in quick order
+1 ; PROMPTID:
+2 ; OPURG:URGENCY
+3 ; OPCDT:COLLECTION DATE/TIME
+4 ; OPSSB:SPECIMEN SUBMITTED BY
+5 ; OPCTY:COLLECTION TYPE
+6 ; OPHOF:HOW OFTEN
+7 ; OPSPH:SURGEON/PROVIDER
+8 ; OPODC:ORDER COMMENT
+9 NEW OK,IEN,PIDX
+10 IF "^OPURG^OPCDT^OPSSB^OPCTY^OPHOF^OPSPH^OPODC^"'[(U_$GET(PROMPTID)_U)
QUIT 0
+11 SET OK=1
SET IEN=$$GETDLGIEN
+12 IF 'IEN
SET OK=0
+13 IF '$TEST
Begin DoDot:1
+14 SET PIDX=$ORDER(^ORD(101.45,IEN,1,"B",PROMPTID,0))
+15 IF PIDX
IF $PIECE($GET(^ORD(101.45,IEN,1,PIDX,0)),U,2)
SET OK=0
End DoDot:1
+16 QUIT OK
+17 ;
GETPAGECODES(CODE) ;
+1 SET CODE(1)="Clinical History^CLINHX"
+2 SET CODE(2)="Pre-Operative Diagnosis^PREOPDX"
+3 SET CODE(3)="Operative Findings^OPFIND"
+4 SET CODE(4)="Post-Operative Findings^POSTOPDX"
+5 QUIT
+6 ;
ASKPAGE(PAGEID) ; Allow page selection in quick order
+1 NEW OK,IEN,IDX,PAGE,CODE,FOUND
+2 DO GETPAGECODES(.CODE)
+3 SET (IDX,FOUND)=0
FOR
SET IDX=$ORDER(CODE(IDX))
if 'IDX
QUIT
Begin DoDot:1
+4 IF PAGEID=$PIECE(CODE(IDX),U,2)
SET FOUND=1
End DoDot:1
if FOUND
QUIT
+5 IF 'FOUND
QUIT 0
+6 SET OK=0
SET IEN=$$GETDLGIEN
IF IEN
Begin DoDot:1
+7 SET IDX=0
FOR
SET IDX=$ORDER(^ORD(101.45,IEN,2,IDX))
if 'IDX
QUIT
Begin DoDot:2
+8 SET PAGE=$GET(^ORD(101.45,IEN,2,IDX,0))
+9 IF $PIECE(PAGE,U,5)=PAGEID
IF '$PIECE(PAGE,U,3)
SET OK=1
End DoDot:2
if OK
QUIT
End DoDot:1
+10 QUIT OK
+11 ;
ALLOWSPEC(SPEC) ; Allow specimens
+1 NEW IEN,OK
+2 SET OK=0
SET IEN=$$GETDLGIEN
+3 IF IEN
Begin DoDot:1
+4 IF $PIECE($GET(^ORD(101.45,IEN,0)),U,2)
SET OK=1
+5 IF '$TEST
IF +$ORDER(^ORD(101.45,IEN,3,"B",SPEC,0))
SET OK=1
End DoDot:1
+6 QUIT OK
+7 ;
GETCOUNT(IDX) ; Get the count of the spcific prompt
+1 NEW COUNT,I
+2 SET (COUNT,I)=0
+3 FOR
SET I=$ORDER(ORDIALOG(IDX,I))
if 'I
QUIT
SET COUNT=COUNT+1
+4 QUIT COUNT
+5 ;
SHOWCOUNT(COUNT,DESC) ; Show count line
+1 NEW SS,ZMSG
SET SS=$SELECT(COUNT=1:"",1:"s")
SET ZMSG=""
+2 IF COUNT<1
SET COUNT="No"
SET ZMSG=" (must have at lease one)"
+3 WRITE " *** "_COUNT_" "_DESC_SS_" found"_ZMSG_".",?SIZE,"***",!
+4 QUIT
+5 ;
ISINVALID() ; Validate AP Dialog quick order before saving
+1 NEW INVALID,IDX,SIZE,SAMPIDX,SPECIDX,DESCIDX,SAMPCOUNT,SPECCOUNT,DESCCOUNT
+2 SET INVALID=1
Begin DoDot:1
+3 SET SAMPIDX=$PIECE($GET(ORDIALOG("B","COLLECTION SAMPLE")),U,2)
if 'SAMPIDX
QUIT
+4 SET SPECIDX=$PIECE($GET(ORDIALOG("B","SPECIMEN")),U,2)
if 'SPECIDX
QUIT
+5 SET DESCIDX=$PIECE($GET(ORDIALOG("B","SPECIMEN DESCRIPTION")),U,2)
if 'DESCIDX
QUIT
+6 SET INVALID=0
End DoDot:1
+7 IF 'INVALID
Begin DoDot:1
+8 SET SAMPCOUNT=$$GETCOUNT(SAMPIDX)
+9 SET SPECCOUNT=$$GETCOUNT(SPECIDX)
+10 SET DESCCOUNT=$$GETCOUNT(DESCIDX)
+11 IF (SAMPCOUNT<1)!(SAMPCOUNT'=SPECCOUNT)!(SAMPCOUNT'=DESCCOUNT)
Begin DoDot:2
+12 SET INVALID=1
SET SIZE=69
+13 WRITE !,$CHAR(7)," "_$$REPEAT^XLFSTR("*",SIZE+2),!
+14 WRITE " *** Anatomic Pathology Quick Order is not valid!",?SIZE,"***",!
+15 WRITE " ***",?SIZE,"***",!
+16 DO SHOWCOUNT(SAMPCOUNT,"Collection Sample")
+17 DO SHOWCOUNT(SPECCOUNT,"Specimen")
+18 DO SHOWCOUNT(DESCCOUNT,"Specimen Description")
+19 WRITE " ***",?SIZE,"***",!
+20 WRITE " *** The same number of Collection Samples, Specimens",?SIZE,"***",!
+21 WRITE " *** and Specimen Descriptions are required!",?SIZE,"***",!
+22 WRITE " "_$$REPEAT^XLFSTR("*",SIZE+2),!
End DoDot:2
End DoDot:1
+23 QUIT INVALID
+24 ;
PROMPTINFO(TYPE) ; Returns item info from the LR OTHER LAB AP TESTS order dialog
+1 ; Return Data = AP Dlg IEN^Item Multiple IEN^Child Dlg IEN
+2 NEW ASKCODE,APDLG,DATA,IDX,X0,DONE,ITEM
+3 if $GET(TYPE)=""
QUIT ""
+4 SET ASKCODE="$$ASKPROMPT^ORWLRAP2("""_TYPE_""")"
+5 SET DATA=""
SET APDLG=$ORDER(^ORD(101.41,"B","LR OTHER LAB AP TESTS",0))
if 'APDLG
QUIT ""
+6 SET (DONE,IDX)=0
FOR
SET IDX=$ORDER(^ORD(101.41,APDLG,10,IDX))
if DONE!('IDX)
QUIT
Begin DoDot:1
+7 IF $GET(^ORD(101.41,APDLG,10,IDX,3))[ASKCODE
Begin DoDot:2
+8 SET X0=$GET(^ORD(101.41,APDLG,10,IDX,0))
SET ITEM=$PIECE(X0,U,2)
+9 SET DATA=APDLG_U_IDX_U_ITEM
End DoDot:2
SET DONE=1
End DoDot:1
+10 QUIT DATA
+11 ;
ISTEXT(LABIEN,PROMPTIEN) ;
+1 NEW TYPE,ITEM
+2 SET TYPE=$PIECE($GET(^ORD(101.45,LABIEN,1,PROMPTIEN,0)),U)
+3 SET ITEM=$PIECE($$PROMPTINFO(TYPE),U,3)
+4 IF +ITEM
IF "^S^P^R^"'[(U_$PIECE($GET(^ORD(101.41,ITEM,1)),U)_U)
QUIT 1
+5 QUIT 0
+6 ;
OK2DELETE(DEFAULT) ;
+1 NEW OK
+2 SET OK=0
+3 IF DEFAULT'=""
Begin DoDot:1
+4 NEW DIR,DA,X,Y,DIRUT
+5 SET DIR(0)="YAO"
SET DIR("A")=" SURE YOU WANT TO DELETE? "
+6 DO ^DIR
+7 IF Y=1
SET OK=1
+8 IF '$TEST
WRITE " <NOTHING DELETED>"
End DoDot:1
+9 QUIT OK
+10 ;
GETDEFAULT(LABIEN,PROMPTIEN) ; Used by Input Template OR AP DIALOG EDIT TEMPLATE
+1 NEW REC,TYPE,DEFAULT,INFO,APDLG,IDX,ITEM,X1,PRTYPE,HELP
+2 NEW DIR,DA,X,Y,DIRUT,DONE
+3 SET REC=$GET(^ORD(101.45,LABIEN,1,PROMPTIEN,0))
+4 SET TYPE=$PIECE(REC,U)
SET DEFAULT=$PIECE(REC,U,4)
if TYPE=""
QUIT DEFAULT
+5 SET INFO=$$PROMPTINFO(TYPE)
if INFO=""
QUIT DEFAULT
+6 SET APDLG=$PIECE(INFO,U,1)
SET IDX=$PIECE(INFO,U,2)
SET ITEM=$PIECE(INFO,U,3)
+7 SET X1=$GET(^ORD(101.41,ITEM,1))
SET PRTYPE=$PIECE(X1,U,1)
SET HELP=$PIECE($GET(^ORD(101.41,APDLG,10,IDX,1)),U,1)
+8 SET DIR("A")=" DEFAULT: "
+9 IF HELP'=""
SET DIR("?")=HELP
+10 ; Pointer Type
IF PRTYPE="P"
Begin DoDot:1
+11 NEW FILE,VAL
+12 SET FILE=+$PIECE(X1,U,2)
SET DIR(0)="PAOr^"_FILE_":AEQM"
+13 IF +DEFAULT
DO EXTNAME^ORWU(.VAL,+DEFAULT,FILE)
if VAL'=""
SET DIR("B")=VAL
+14 FOR
SET DONE=1
Begin DoDot:2
+15 DO ^DIR
IF $GET(X)="@"
Begin DoDot:3
+16 SET DONE=$$OK2DELETE(DEFAULT)
+17 IF DONE
SET DEFAULT="@"
End DoDot:3
IF 1
+18 IF '$TEST
IF '$DATA(DIRUT)
IF +Y>0
SET DEFAULT=+Y
End DoDot:2
if DONE
QUIT
End DoDot:1
IF 1
+19 ; Set of Codes
IF '$TEST
IF PRTYPE="S"
Begin DoDot:1
+20 NEW CODES,P1,P2
+21 SET CODES=$PIECE(X1,U,2)
SET DIR(0)="SAO^"_CODES
+22 IF DEFAULT'=""
Begin DoDot:2
+23 SET P1=$FIND(CODES,DEFAULT_":")
+24 IF P1
Begin DoDot:3
+25 SET P2=$FIND(CODES,";",P1)
IF 'P2
SET P2=$LENGTH(CODES)+2
+26 SET DIR("B")=$EXTRACT(CODES,P1,P2-2)
End DoDot:3
IF 1
+27 ; Code not found
IF '$TEST
SET DEFAULT="@"
End DoDot:2
+28 FOR
SET DONE=1
Begin DoDot:2
+29 DO ^DIR
IF $GET(X)="@"
Begin DoDot:3
+30 SET DONE=$$OK2DELETE(DEFAULT)
+31 IF DONE
SET DEFAULT="@"
End DoDot:3
IF 1
+32 IF '$TEST
IF '$DATA(DIRUT)
IF Y'=""
SET DEFAULT=Y
End DoDot:2
if DONE
QUIT
End DoDot:1
IF 1
+33 ; Free Text Date/Time
IF '$TEST
IF PRTYPE="R"
Begin DoDot:1
+34 SET DIR(0)="DAO^::ET"
+35 IF DEFAULT'=""
SET DIR("B")=DEFAULT
+36 FOR
SET DONE=1
Begin DoDot:2
+37 DO ^DIR
IF $GET(X)="@"
Begin DoDot:3
+38 SET DONE=$$OK2DELETE(DEFAULT)
+39 IF DONE
SET DEFAULT="@"
End DoDot:3
IF 1
+40 IF '$TEST
IF '$DATA(DIRUT)
IF Y>0
SET DEFAULT=X
End DoDot:2
if DONE
QUIT
End DoDot:1
IF 1
+41 QUIT DEFAULT
+42 ;
GETPAGEID(LABIEN,PAGEIEN) ; Used by Input Template OR AP DIALOG EDIT TEMPLATE
+1 NEW REC,NAME,TYPE,DEFAULT,DIR,DA,X,Y,DIRUT,DONE,CODE,IDX,IEN,USEDTYPE,FIRST
+2 SET REC=$GET(^ORD(101.45,LABIEN,2,PAGEIEN,0))
+3 SET NAME=$PIECE(REC,U,2)
SET TYPE=$PIECE(REC,U,5)
+4 DO GETPAGECODES(.CODE)
+5 SET IEN=0
FOR
SET IEN=$ORDER(^ORD(101.45,LABIEN,2,IEN))
if 'IEN
QUIT
if IEN'=PAGEIEN
Begin DoDot:1
+6 SET USEDTYPE=$PIECE($GET(^ORD(101.45,LABIEN,2,IEN,0)),U,5)
+7 IF USEDTYPE'=""
Begin DoDot:2
+8 SET (DONE,IDX)=0
FOR
SET IDX=$ORDER(CODE(IDX))
if 'IDX
QUIT
Begin DoDot:3
+9 IF USEDTYPE=$PIECE(CODE(IDX),U,2)
KILL CODE(IDX)
SET DONE=1
End DoDot:3
if DONE
QUIT
End DoDot:2
End DoDot:1
+10 SET DIR(0)="SA^"
SET DIR("A")=" PAGE TYPE: "
SET DEFAULT=""
+11 SET DIR("?")="Enter the type of page (types already used have been removed)."
+12 SET IDX=0
SET FIRST=1
FOR
SET IDX=$ORDER(CODE(IDX))
if 'IDX
QUIT
Begin DoDot:1
+13 SET DIR(0)=DIR(0)_$SELECT(FIRST:"",1:";")_IDX_":"_$PIECE(CODE(IDX),U)
SET FIRST=0
End DoDot:1
+14 IF TYPE'=""
Begin DoDot:1
+15 SET (IDX,DONE)=0
FOR
SET IDX=$ORDER(CODE(IDX))
if 'IDX
QUIT
Begin DoDot:2
+16 IF TYPE=$PIECE(CODE(IDX),U,2)
SET DIR("B")=$PIECE(CODE(IDX),U)
SET DEFAULT=TYPE
SET DONE=1
End DoDot:2
if DONE
QUIT
End DoDot:1
+17 DO ^DIR
+18 IF '$DATA(DIRUT)
IF +Y>0
SET DEFAULT=$PIECE($GET(CODE(+Y)),U,2)
+19 QUIT DEFAULT
+20 ;
GETPAGENAME(LABIEN,PAGEIEN,TYPE) ; Used by Input Template OR AP DIALOG EDIT TEMPLATE
+1 NEW NAME,CODE,IDX,DONE
+2 SET NAME=$PIECE($GET(^ORD(101.45,LABIEN,2,PAGEIEN,0)),U,2)
+3 IF NAME=""
IF TYPE'=""
Begin DoDot:1
+4 DO GETPAGECODES(.CODE)
+5 SET (IDX,DONE)=0
FOR
SET IDX=$ORDER(CODE(IDX))
if 'IDX
QUIT
Begin DoDot:2
+6 IF TYPE=$PIECE(CODE(IDX),U,2)
SET NAME=$PIECE(CODE(IDX),U)
SET DONE=1
End DoDot:2
if DONE
QUIT
End DoDot:1
+7 QUIT NAME
+8 ;
