- 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 Jan 18, 2025@03:31:01 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