ORDD43 ; SLC/MKB - Build xrefs for file 101.43 ;7/2/97 10:52
;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,68,94,164,190**;Dec 17, 1997
;
SET(X,IFN) ; Create new entry X in SET multiple
N DIC,DA,Y Q:$D(^ORD(101.43,IFN,9,"B",X)) ; already exists
S DIC="^ORD(101.43,"_IFN_",9,",DIC(0)="L",DA(1)=IFN
S DIC("P")=$P(^DD(101.43,9,0),U,2) K DD,DO
S ^ORD(101.43,"AH",X)=$H
S ^ORD(101.43,"AH","S."_X)=$H
D FILE^DICN
Q
;
KILL(X,IFN) ; Remove entry X from SET multiple
N DIK,DA
S DIK="^ORD(101.43,"_IFN_",9,",DA(1)=IFN
S ^ORD(101.43,"AH",X)=$H
S DA=$O(^ORD(101.43,IFN,9,"B",X,0)) I DA D ^DIK
Q
;
SETRA(NAME,ITYPE,CPROC) ; Set COMMON xref
Q:'CPROC Q:'$L(ITYPE) ; not common, no IType
S ^ORD(101.43,"COMMON",ITYPE,NAME,DA)=""
Q
;
KILLRA(NAME,ITYPE,CPROC) ; Kill COMMON xref
Q:'CPROC Q:'$L(ITYPE) ; not common, no IType
K ^ORD(101.43,"COMMON",ITYPE,NAME,DA)
Q
;
SS(NAME,DATE,LABTYP) ; -- Set S.SET xref by Name, Set multiple
Q:'$L($G(NAME)) I ($G(LABTYP)="O")!($G(LABTYP)="N") D SK(NAME) Q
N SET,SET0,SETNM,SETLST,QO
S SET=0 F S SET=$O(^ORD(101.43,DA,9,SET)) Q:SET'>0 S SET0=$G(^(SET,0)) D
. S SETNM=$P(SET0,U),QO=$P(SET0,U,2)
. S ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(NAME),DA)=U_NAME_U_$G(DATE)_U_U_QO
. S ^ORD(101.43,"AH","S."_SETNM)=$H,SETLST("S."_SETNM)=""
I $G(DATE),(DATE>$$NOW^XLFDT) D
. N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
. S ZTRTN="DQAH^ORDD43",ZTDESC="CPRS AH Update",ZTDTH=DATE,ZTIO=""
. S ZTSAVE("SETLST(")="" D ^%ZTLOAD
Q
DQAH ; -- set new timestamps for sets where items are becoming inactive
S ZTREQ="@"
N X
S X="" F S X=$O(SETLST(X)) Q:X="" S ^ORD(101.43,"AH",X)=$H
Q
;
SK(NAME) ; -- Kill S.SET xref by Name, Set multiple
Q:'$L($G(NAME)) N SET,SETNM
S SET=0 F S SET=$O(^ORD(101.43,DA,9,SET)) Q:SET'>0 S SETNM=$P(^(SET,0),U) D
. K ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(NAME),DA)
. S ^ORD(101.43,"AH","S."_SETNM)=$H
Q
;
SS1(NAME,DATE,LABTYP) ; -- Set S.SET mnemonic xref by Synonym, Name, Set
Q:'$L($G(NAME)) I ($G(LABTYP)="O")!($G(LABTYP)="N") D SK1(NAME) Q
N SYN,SYNM,SET,SET0,SETNM,QO
S SET=0 F S SET=$O(^ORD(101.43,DA,9,SET)) Q:SET'>0 S SET0=$G(^(SET,0)) D
. S SETNM=$P(SET0,U),QO=$P(SET0,U,2)
. S SYN=0 F S SYN=$O(^ORD(101.43,DA,2,SYN)) Q:SYN'>0 S SYNM=$P(^(SYN,0),U) D
. . S:SYNM'=NAME ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(SYNM),DA)="1^"_SYNM_U_$G(DATE)_U_NAME_U_QO
. . S ^ORD(101.43,"AH","S."_SETNM)=$H
Q
;
SK1(NAME) ; -- Kill S.SET mnemonic xref by Synonym, Name, Set
N SYN,SYNM,SET,SETNM
S SET=0 F S SET=$O(^ORD(101.43,DA,9,SET)) Q:SET'>0 S SETNM=$P(^(SET,0),U) D
. S SYN=0 F S SYN=$O(^ORD(101.43,DA,2,SYN)) Q:SYN'>0 S SYNM=$P(^(SYN,0),U) D
. . I $G(^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(SYNM),DA)) K ^(DA)
. . S ^ORD(101.43,"AH","S."_SETNM)=$H
Q
;
SS2 ; -- Set S.SET mnemonic xref from SET multiple
N TYP,NAME,DATE,SYN,SYNM,I,QO
S TYP=$P($G(^ORD(101.43,DA(1),"LR")),U,7) I (TYP="O")!(TYP="N") D SK2 Q
S I=+$O(^ORD(101.43,DA(1),9,"B",X,0))
S QO=$P($G(^ORD(101.43,DA(1),9,I,0)),U,2)
S SYN=0,NAME=$P(^ORD(101.43,DA(1),0),U),DATE=$G(^(.1))
F S SYN=$O(^ORD(101.43,DA(1),2,SYN)) Q:SYN'>0 S SYNM=$P(^(SYN,0),U) D
. S:SYNM'=NAME ^ORD(101.43,"S."_X,$$UP^XLFSTR(SYNM),DA(1))="1^"_SYNM_U_DATE_U_NAME_U_QO
. S ^ORD(101.43,"AH","S."_X)=$H
Q
;
SK2 ; -- Kill S.SET mnemonic xref from SET multiple
N SYN,SYNM
S SYN=0 F S SYN=$O(^ORD(101.43,DA(1),2,SYN)) Q:SYN'>0 S SYNM=$P(^(SYN,0),U) D
. I $G(^ORD(101.43,"S."_X,$$UP^XLFSTR(SYNM),DA(1))) K ^(DA(1))
. S ^ORD(101.43,"AH","S."_X)=$H
Q
;
SS3 ; -- Set S.SET mnemonic xref from SYN multiple
N TYP,NAME,DATE,SET,SET0,SETNM,QO
S TYP=$P($G(^ORD(101.43,DA(1),"LR")),U,7) I (TYP="O")!(TYP="N") D SK3 Q
S NAME=$P(^ORD(101.43,DA(1),0),U),DATE=$G(^(.1)),SET=0 Q:X=NAME
F S SET=$O(^ORD(101.43,DA(1),9,SET)) Q:SET'>0 S SET0=$G(^(SET,0)) D
. S SETNM=$P(SET0,U),QO=$P(SET0,U,2)
. S ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(X),DA(1))="1^"_X_U_DATE_U_NAME_U_QO
. S ^ORD(101.43,"AH","S."_SETNM)=$H
Q
;
SK3 ; -- Kill S.SET mnemonic xref from SYN multiple
N SET,SETNM
S SET=0 F S SET=$O(^ORD(101.43,DA(1),9,SET)) Q:SET'>0 S SETNM=$P(^(SET,0),U) D
. I $G(^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(X),DA(1))) K ^(DA(1))
. S ^ORD(101.43,"AH","S."_SETNM)=$H
Q
;
CS(NAME,CODE,DATE) ; -- Set C.SET xref by 'Code Name', Set
Q:'$L($G(NAME)) Q:'$L($G(CODE))
N X,XP,ORS,SET0,SETNM,QO
S X=CODE_" "_NAME,XP=$$UP^XLFSTR(X)
S ORS=0 F S ORS=$O(^ORD(101.43,DA,9,ORS)) Q:ORS'>0 S SET0=$G(^(ORS,0)) D
. S SETNM=$P(SET0,U),QO=$P(SET0,U,2)
. S ^ORD(101.43,"C."_SETNM,XP,DA)=U_X_U_$G(DATE)_U_U_QO
Q
;
CK(NAME,CODE) ; -- Kill C.SET xref
Q:'$L($G(NAME)) Q:'$L($G(CODE))
N XP,ORS,ORSET S XP=$$UP^XLFSTR(CODE_" "_NAME)
S ORS=0 F S ORS=$O(^ORD(101.43,DA,9,ORS)) Q:ORS'>0 S ORSET=$P(^(ORS,0),U) K ^ORD(101.43,"C."_ORSET,XP,DA)
Q
;
QO(X) ; -- Add data to SET xrefs, set/kill AQO xref
N NAME,XREF,SYN,SYNM S X=$G(X)
S NAME=$$UP^XLFSTR($P($G(^ORD(101.43,DA(1),0)),U)),XREF="S."_$P($G(^(9,DA,0)),U)
S:X ^ORD(101.43,DA(1),9,"AQO",XREF)=""
K:'X ^ORD(101.43,DA(1),9,"AQO",XREF)
Q:'$D(^ORD(101.43,XREF,NAME,DA(1))) S $P(^(DA(1)),U,5)=X
S SYN=0 F S SYN=+$O(^ORD(101.43,DA(1),2,SYN)) Q:SYN<1 S SYNM=$P($G(^(SYN,0)),U),$P(^ORD(101.43,XREF,$$UP^XLFSTR(SYNM),DA(1)),U,5)=X
S ^ORD(101.43,"AH",XREF)=$H
Q
;
XHELP(INDEX,SCREEN) ; -- ??Help
N X,Y,Y0,Z,SYN,CNT,D,DONE
S:'$L($G(INDEX)) INDEX="B" W !!,"Choose from:" S CNT=1,D=INDEX
S X="" F S X=$O(^ORD(101.43,INDEX,X)) Q:X="" S Y=0 D Q:$G(DONE)
. F S Y=$O(^ORD(101.43,INDEX,X,Y)) Q:Y'>0 S SYN=$G(^(Y)) I 'SYN D Q:$G(DONE)
. . S Y0=$G(^ORD(101.43,Y,0)) X:$L($G(SCREEN)) SCREEN Q:'$T
. . W !," "_X ;W:SYN " "_$P(SYN,U,4) ; echo .01 if synonym
. . S CNT=CNT+1 Q:CNT'>(IOSL-5) S CNT=0
. . W !," '^' TO STOP: " R Z:DTIME S:'$T!(Z["^") DONE=1
W !
Q
;
ACTIVE(ITM) ; -- Screen, if inactive or restricted to QO use only
; Use in DIC("S") when searching #101.43
N Y S Y=1
I $G(ORTYPE)="D",$L($G(D)),$D(^ORD(101.43,+ITM,9,"AQO",$P(D,U))) S Y=0
I $G(^ORD(101.43,+ITM,.1)),^(.1)'>$$NOW^XLFDT S Y=0 ;inactive
Q Y
;
ID(OLD,NEW) ; -- API for package to update ID field [ code;99XXX ]
; Returns 1 or 0, if successful or not
N IFN,Y S Y=0
G:'$G(OLD) IDQ G:$G(NEW)'?1.N1";99"3U IDQ ;invalid
S IFN=+$O(^ORD(101.43,"ID",OLD,0)) G:IFN'>0 IDQ
K ^ORD(101.43,"ID",OLD,IFN)
S $P(^ORD(101.43,IFN,0),U,2)=NEW,^ORD(101.43,"ID",NEW,IFN)="",Y=1
IDQ Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDD43 6488 printed Apr 09, 2024@21:24:57 Page 2
ORDD43 ; SLC/MKB - Build xrefs for file 101.43 ;7/2/97 10:52
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**26,68,94,164,190**;Dec 17, 1997
+2 ;
SET(X,IFN) ; Create new entry X in SET multiple
+1 ; already exists
NEW DIC,DA,Y
if $DATA(^ORD(101.43,IFN,9,"B",X))
QUIT
+2 SET DIC="^ORD(101.43,"_IFN_",9,"
SET DIC(0)="L"
SET DA(1)=IFN
+3 SET DIC("P")=$PIECE(^DD(101.43,9,0),U,2)
KILL DD,DO
+4 SET ^ORD(101.43,"AH",X)=$HOROLOG
+5 SET ^ORD(101.43,"AH","S."_X)=$HOROLOG
+6 DO FILE^DICN
+7 QUIT
+8 ;
KILL(X,IFN) ; Remove entry X from SET multiple
+1 NEW DIK,DA
+2 SET DIK="^ORD(101.43,"_IFN_",9,"
SET DA(1)=IFN
+3 SET ^ORD(101.43,"AH",X)=$HOROLOG
+4 SET DA=$ORDER(^ORD(101.43,IFN,9,"B",X,0))
IF DA
DO ^DIK
+5 QUIT
+6 ;
SETRA(NAME,ITYPE,CPROC) ; Set COMMON xref
+1 ; not common, no IType
if 'CPROC
QUIT
if '$LENGTH(ITYPE)
QUIT
+2 SET ^ORD(101.43,"COMMON",ITYPE,NAME,DA)=""
+3 QUIT
+4 ;
KILLRA(NAME,ITYPE,CPROC) ; Kill COMMON xref
+1 ; not common, no IType
if 'CPROC
QUIT
if '$LENGTH(ITYPE)
QUIT
+2 KILL ^ORD(101.43,"COMMON",ITYPE,NAME,DA)
+3 QUIT
+4 ;
SS(NAME,DATE,LABTYP) ; -- Set S.SET xref by Name, Set multiple
+1 if '$LENGTH($GET(NAME))
QUIT
IF ($GET(LABTYP)="O")!($GET(LABTYP)="N")
DO SK(NAME)
QUIT
+2 NEW SET,SET0,SETNM,SETLST,QO
+3 SET SET=0
FOR
SET SET=$ORDER(^ORD(101.43,DA,9,SET))
if SET'>0
QUIT
SET SET0=$GET(^(SET,0))
Begin DoDot:1
+4 SET SETNM=$PIECE(SET0,U)
SET QO=$PIECE(SET0,U,2)
+5 SET ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(NAME),DA)=U_NAME_U_$GET(DATE)_U_U_QO
+6 SET ^ORD(101.43,"AH","S."_SETNM)=$HOROLOG
SET SETLST("S."_SETNM)=""
End DoDot:1
+7 IF $GET(DATE)
IF (DATE>$$NOW^XLFDT)
Begin DoDot:1
+8 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
+9 SET ZTRTN="DQAH^ORDD43"
SET ZTDESC="CPRS AH Update"
SET ZTDTH=DATE
SET ZTIO=""
+10 SET ZTSAVE("SETLST(")=""
DO ^%ZTLOAD
End DoDot:1
+11 QUIT
DQAH ; -- set new timestamps for sets where items are becoming inactive
+1 SET ZTREQ="@"
+2 NEW X
+3 SET X=""
FOR
SET X=$ORDER(SETLST(X))
if X=""
QUIT
SET ^ORD(101.43,"AH",X)=$HOROLOG
+4 QUIT
+5 ;
SK(NAME) ; -- Kill S.SET xref by Name, Set multiple
+1 if '$LENGTH($GET(NAME))
QUIT
NEW SET,SETNM
+2 SET SET=0
FOR
SET SET=$ORDER(^ORD(101.43,DA,9,SET))
if SET'>0
QUIT
SET SETNM=$PIECE(^(SET,0),U)
Begin DoDot:1
+3 KILL ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(NAME),DA)
+4 SET ^ORD(101.43,"AH","S."_SETNM)=$HOROLOG
End DoDot:1
+5 QUIT
+6 ;
SS1(NAME,DATE,LABTYP) ; -- Set S.SET mnemonic xref by Synonym, Name, Set
+1 if '$LENGTH($GET(NAME))
QUIT
IF ($GET(LABTYP)="O")!($GET(LABTYP)="N")
DO SK1(NAME)
QUIT
+2 NEW SYN,SYNM,SET,SET0,SETNM,QO
+3 SET SET=0
FOR
SET SET=$ORDER(^ORD(101.43,DA,9,SET))
if SET'>0
QUIT
SET SET0=$GET(^(SET,0))
Begin DoDot:1
+4 SET SETNM=$PIECE(SET0,U)
SET QO=$PIECE(SET0,U,2)
+5 SET SYN=0
FOR
SET SYN=$ORDER(^ORD(101.43,DA,2,SYN))
if SYN'>0
QUIT
SET SYNM=$PIECE(^(SYN,0),U)
Begin DoDot:2
+6 if SYNM'=NAME
SET ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(SYNM),DA)="1^"_SYNM_U_$GET(DATE)_U_NAME_U_QO
+7 SET ^ORD(101.43,"AH","S."_SETNM)=$HOROLOG
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
SK1(NAME) ; -- Kill S.SET mnemonic xref by Synonym, Name, Set
+1 NEW SYN,SYNM,SET,SETNM
+2 SET SET=0
FOR
SET SET=$ORDER(^ORD(101.43,DA,9,SET))
if SET'>0
QUIT
SET SETNM=$PIECE(^(SET,0),U)
Begin DoDot:1
+3 SET SYN=0
FOR
SET SYN=$ORDER(^ORD(101.43,DA,2,SYN))
if SYN'>0
QUIT
SET SYNM=$PIECE(^(SYN,0),U)
Begin DoDot:2
+4 IF $GET(^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(SYNM),DA))
KILL ^(DA)
+5 SET ^ORD(101.43,"AH","S."_SETNM)=$HOROLOG
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
SS2 ; -- Set S.SET mnemonic xref from SET multiple
+1 NEW TYP,NAME,DATE,SYN,SYNM,I,QO
+2 SET TYP=$PIECE($GET(^ORD(101.43,DA(1),"LR")),U,7)
IF (TYP="O")!(TYP="N")
DO SK2
QUIT
+3 SET I=+$ORDER(^ORD(101.43,DA(1),9,"B",X,0))
+4 SET QO=$PIECE($GET(^ORD(101.43,DA(1),9,I,0)),U,2)
+5 SET SYN=0
SET NAME=$PIECE(^ORD(101.43,DA(1),0),U)
SET DATE=$GET(^(.1))
+6 FOR
SET SYN=$ORDER(^ORD(101.43,DA(1),2,SYN))
if SYN'>0
QUIT
SET SYNM=$PIECE(^(SYN,0),U)
Begin DoDot:1
+7 if SYNM'=NAME
SET ^ORD(101.43,"S."_X,$$UP^XLFSTR(SYNM),DA(1))="1^"_SYNM_U_DATE_U_NAME_U_QO
+8 SET ^ORD(101.43,"AH","S."_X)=$HOROLOG
End DoDot:1
+9 QUIT
+10 ;
SK2 ; -- Kill S.SET mnemonic xref from SET multiple
+1 NEW SYN,SYNM
+2 SET SYN=0
FOR
SET SYN=$ORDER(^ORD(101.43,DA(1),2,SYN))
if SYN'>0
QUIT
SET SYNM=$PIECE(^(SYN,0),U)
Begin DoDot:1
+3 IF $GET(^ORD(101.43,"S."_X,$$UP^XLFSTR(SYNM),DA(1)))
KILL ^(DA(1))
+4 SET ^ORD(101.43,"AH","S."_X)=$HOROLOG
End DoDot:1
+5 QUIT
+6 ;
SS3 ; -- Set S.SET mnemonic xref from SYN multiple
+1 NEW TYP,NAME,DATE,SET,SET0,SETNM,QO
+2 SET TYP=$PIECE($GET(^ORD(101.43,DA(1),"LR")),U,7)
IF (TYP="O")!(TYP="N")
DO SK3
QUIT
+3 SET NAME=$PIECE(^ORD(101.43,DA(1),0),U)
SET DATE=$GET(^(.1))
SET SET=0
if X=NAME
QUIT
+4 FOR
SET SET=$ORDER(^ORD(101.43,DA(1),9,SET))
if SET'>0
QUIT
SET SET0=$GET(^(SET,0))
Begin DoDot:1
+5 SET SETNM=$PIECE(SET0,U)
SET QO=$PIECE(SET0,U,2)
+6 SET ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(X),DA(1))="1^"_X_U_DATE_U_NAME_U_QO
+7 SET ^ORD(101.43,"AH","S."_SETNM)=$HOROLOG
End DoDot:1
+8 QUIT
+9 ;
SK3 ; -- Kill S.SET mnemonic xref from SYN multiple
+1 NEW SET,SETNM
+2 SET SET=0
FOR
SET SET=$ORDER(^ORD(101.43,DA(1),9,SET))
if SET'>0
QUIT
SET SETNM=$PIECE(^(SET,0),U)
Begin DoDot:1
+3 IF $GET(^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(X),DA(1)))
KILL ^(DA(1))
+4 SET ^ORD(101.43,"AH","S."_SETNM)=$HOROLOG
End DoDot:1
+5 QUIT
+6 ;
CS(NAME,CODE,DATE) ; -- Set C.SET xref by 'Code Name', Set
+1 if '$LENGTH($GET(NAME))
QUIT
if '$LENGTH($GET(CODE))
QUIT
+2 NEW X,XP,ORS,SET0,SETNM,QO
+3 SET X=CODE_" "_NAME
SET XP=$$UP^XLFSTR(X)
+4 SET ORS=0
FOR
SET ORS=$ORDER(^ORD(101.43,DA,9,ORS))
if ORS'>0
QUIT
SET SET0=$GET(^(ORS,0))
Begin DoDot:1
+5 SET SETNM=$PIECE(SET0,U)
SET QO=$PIECE(SET0,U,2)
+6 SET ^ORD(101.43,"C."_SETNM,XP,DA)=U_X_U_$GET(DATE)_U_U_QO
End DoDot:1
+7 QUIT
+8 ;
CK(NAME,CODE) ; -- Kill C.SET xref
+1 if '$LENGTH($GET(NAME))
QUIT
if '$LENGTH($GET(CODE))
QUIT
+2 NEW XP,ORS,ORSET
SET XP=$$UP^XLFSTR(CODE_" "_NAME)
+3 SET ORS=0
FOR
SET ORS=$ORDER(^ORD(101.43,DA,9,ORS))
if ORS'>0
QUIT
SET ORSET=$PIECE(^(ORS,0),U)
KILL ^ORD(101.43,"C."_ORSET,XP,DA)
+4 QUIT
+5 ;
QO(X) ; -- Add data to SET xrefs, set/kill AQO xref
+1 NEW NAME,XREF,SYN,SYNM
SET X=$GET(X)
+2 SET NAME=$$UP^XLFSTR($PIECE($GET(^ORD(101.43,DA(1),0)),U))
SET XREF="S."_$PIECE($GET(^(9,DA,0)),U)
+3 if X
SET ^ORD(101.43,DA(1),9,"AQO",XREF)=""
+4 if 'X
KILL ^ORD(101.43,DA(1),9,"AQO",XREF)
+5 if '$DATA(^ORD(101.43,XREF,NAME,DA(1)))
QUIT
SET $PIECE(^(DA(1)),U,5)=X
+6 SET SYN=0
FOR
SET SYN=+$ORDER(^ORD(101.43,DA(1),2,SYN))
if SYN<1
QUIT
SET SYNM=$PIECE($GET(^(SYN,0)),U)
SET $PIECE(^ORD(101.43,XREF,$$UP^XLFSTR(SYNM),DA(1)),U,5)=X
+7 SET ^ORD(101.43,"AH",XREF)=$HOROLOG
+8 QUIT
+9 ;
XHELP(INDEX,SCREEN) ; -- ??Help
+1 NEW X,Y,Y0,Z,SYN,CNT,D,DONE
+2 if '$LENGTH($GET(INDEX))
SET INDEX="B"
WRITE !!,"Choose from:"
SET CNT=1
SET D=INDEX
+3 SET X=""
FOR
SET X=$ORDER(^ORD(101.43,INDEX,X))
if X=""
QUIT
SET Y=0
Begin DoDot:1
+4 FOR
SET Y=$ORDER(^ORD(101.43,INDEX,X,Y))
if Y'>0
QUIT
SET SYN=$GET(^(Y))
IF 'SYN
Begin DoDot:2
+5 SET Y0=$GET(^ORD(101.43,Y,0))
if $LENGTH($GET(SCREEN))
XECUTE SCREEN
if '$TEST
QUIT
+6 ;W:SYN " "_$P(SYN,U,4) ; echo .01 if synonym
WRITE !," "_X
+7 SET CNT=CNT+1
if CNT'>(IOSL-5)
QUIT
SET CNT=0
+8 WRITE !," '^' TO STOP: "
READ Z:DTIME
if '$TEST!(Z["^")
SET DONE=1
End DoDot:2
if $GET(DONE)
QUIT
End DoDot:1
if $GET(DONE)
QUIT
+9 WRITE !
+10 QUIT
+11 ;
ACTIVE(ITM) ; -- Screen, if inactive or restricted to QO use only
+1 ; Use in DIC("S") when searching #101.43
+2 NEW Y
SET Y=1
+3 IF $GET(ORTYPE)="D"
IF $LENGTH($GET(D))
IF $DATA(^ORD(101.43,+ITM,9,"AQO",$PIECE(D,U)))
SET Y=0
+4 ;inactive
IF $GET(^ORD(101.43,+ITM,.1))
IF ^(.1)'>$$NOW^XLFDT
SET Y=0
+5 QUIT Y
+6 ;
ID(OLD,NEW) ; -- API for package to update ID field [ code;99XXX ]
+1 ; Returns 1 or 0, if successful or not
+2 NEW IFN,Y
SET Y=0
+3 ;invalid
if '$GET(OLD)
GOTO IDQ
if $GET(NEW)'?1.N1";99"3U
GOTO IDQ
+4 SET IFN=+$ORDER(^ORD(101.43,"ID",OLD,0))
if IFN'>0
GOTO IDQ
+5 KILL ^ORD(101.43,"ID",OLD,IFN)
+6 SET $PIECE(^ORD(101.43,IFN,0),U,2)=NEW
SET ^ORD(101.43,"ID",NEW,IFN)=""
SET Y=1
IDQ QUIT Y
