Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORDD43

ORDD43.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. SET(X,IFN) ; Create new entry X in SET multiple
  1. N DIC,DA,Y Q:$D(^ORD(101.43,IFN,9,"B",X)) ; already exists
  1. S DIC="^ORD(101.43,"_IFN_",9,",DIC(0)="L",DA(1)=IFN
  1. S DIC("P")=$P(^DD(101.43,9,0),U,2) K DD,DO
  1. S ^ORD(101.43,"AH",X)=$H
  1. S ^ORD(101.43,"AH","S."_X)=$H
  1. D FILE^DICN
  1. Q
  1. ;
  1. KILL(X,IFN) ; Remove entry X from SET multiple
  1. N DIK,DA
  1. S DIK="^ORD(101.43,"_IFN_",9,",DA(1)=IFN
  1. S ^ORD(101.43,"AH",X)=$H
  1. S DA=$O(^ORD(101.43,IFN,9,"B",X,0)) I DA D ^DIK
  1. Q
  1. ;
  1. SETRA(NAME,ITYPE,CPROC) ; Set COMMON xref
  1. Q:'CPROC Q:'$L(ITYPE) ; not common, no IType
  1. S ^ORD(101.43,"COMMON",ITYPE,NAME,DA)=""
  1. Q
  1. ;
  1. KILLRA(NAME,ITYPE,CPROC) ; Kill COMMON xref
  1. Q:'CPROC Q:'$L(ITYPE) ; not common, no IType
  1. K ^ORD(101.43,"COMMON",ITYPE,NAME,DA)
  1. Q
  1. ;
  1. SS(NAME,DATE,LABTYP) ; -- Set S.SET xref by Name, Set multiple
  1. Q:'$L($G(NAME)) I ($G(LABTYP)="O")!($G(LABTYP)="N") D SK(NAME) Q
  1. N SET,SET0,SETNM,SETLST,QO
  1. S SET=0 F S SET=$O(^ORD(101.43,DA,9,SET)) Q:SET'>0 S SET0=$G(^(SET,0)) D
  1. . S SETNM=$P(SET0,U),QO=$P(SET0,U,2)
  1. . S ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(NAME),DA)=U_NAME_U_$G(DATE)_U_U_QO
  1. . S ^ORD(101.43,"AH","S."_SETNM)=$H,SETLST("S."_SETNM)=""
  1. I $G(DATE),(DATE>$$NOW^XLFDT) D
  1. . N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTSK
  1. . S ZTRTN="DQAH^ORDD43",ZTDESC="CPRS AH Update",ZTDTH=DATE,ZTIO=""
  1. . S ZTSAVE("SETLST(")="" D ^%ZTLOAD
  1. Q
  1. DQAH ; -- set new timestamps for sets where items are becoming inactive
  1. S ZTREQ="@"
  1. N X
  1. S X="" F S X=$O(SETLST(X)) Q:X="" S ^ORD(101.43,"AH",X)=$H
  1. Q
  1. ;
  1. SK(NAME) ; -- Kill S.SET xref by Name, Set multiple
  1. Q:'$L($G(NAME)) N SET,SETNM
  1. S SET=0 F S SET=$O(^ORD(101.43,DA,9,SET)) Q:SET'>0 S SETNM=$P(^(SET,0),U) D
  1. . K ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(NAME),DA)
  1. . S ^ORD(101.43,"AH","S."_SETNM)=$H
  1. Q
  1. ;
  1. SS1(NAME,DATE,LABTYP) ; -- Set S.SET mnemonic xref by Synonym, Name, Set
  1. Q:'$L($G(NAME)) I ($G(LABTYP)="O")!($G(LABTYP)="N") D SK1(NAME) Q
  1. N SYN,SYNM,SET,SET0,SETNM,QO
  1. S SET=0 F S SET=$O(^ORD(101.43,DA,9,SET)) Q:SET'>0 S SET0=$G(^(SET,0)) D
  1. . S SETNM=$P(SET0,U),QO=$P(SET0,U,2)
  1. . S SYN=0 F S SYN=$O(^ORD(101.43,DA,2,SYN)) Q:SYN'>0 S SYNM=$P(^(SYN,0),U) D
  1. . . S:SYNM'=NAME ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(SYNM),DA)="1^"_SYNM_U_$G(DATE)_U_NAME_U_QO
  1. . . S ^ORD(101.43,"AH","S."_SETNM)=$H
  1. Q
  1. ;
  1. SK1(NAME) ; -- Kill S.SET mnemonic xref by Synonym, Name, Set
  1. N SYN,SYNM,SET,SETNM
  1. S SET=0 F S SET=$O(^ORD(101.43,DA,9,SET)) Q:SET'>0 S SETNM=$P(^(SET,0),U) D
  1. . S SYN=0 F S SYN=$O(^ORD(101.43,DA,2,SYN)) Q:SYN'>0 S SYNM=$P(^(SYN,0),U) D
  1. . . I $G(^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(SYNM),DA)) K ^(DA)
  1. . . S ^ORD(101.43,"AH","S."_SETNM)=$H
  1. Q
  1. ;
  1. SS2 ; -- Set S.SET mnemonic xref from SET multiple
  1. N TYP,NAME,DATE,SYN,SYNM,I,QO
  1. S TYP=$P($G(^ORD(101.43,DA(1),"LR")),U,7) I (TYP="O")!(TYP="N") D SK2 Q
  1. S I=+$O(^ORD(101.43,DA(1),9,"B",X,0))
  1. S QO=$P($G(^ORD(101.43,DA(1),9,I,0)),U,2)
  1. S SYN=0,NAME=$P(^ORD(101.43,DA(1),0),U),DATE=$G(^(.1))
  1. F S SYN=$O(^ORD(101.43,DA(1),2,SYN)) Q:SYN'>0 S SYNM=$P(^(SYN,0),U) D
  1. . S:SYNM'=NAME ^ORD(101.43,"S."_X,$$UP^XLFSTR(SYNM),DA(1))="1^"_SYNM_U_DATE_U_NAME_U_QO
  1. . S ^ORD(101.43,"AH","S."_X)=$H
  1. Q
  1. ;
  1. SK2 ; -- Kill S.SET mnemonic xref from SET multiple
  1. N SYN,SYNM
  1. S SYN=0 F S SYN=$O(^ORD(101.43,DA(1),2,SYN)) Q:SYN'>0 S SYNM=$P(^(SYN,0),U) D
  1. . I $G(^ORD(101.43,"S."_X,$$UP^XLFSTR(SYNM),DA(1))) K ^(DA(1))
  1. . S ^ORD(101.43,"AH","S."_X)=$H
  1. Q
  1. ;
  1. SS3 ; -- Set S.SET mnemonic xref from SYN multiple
  1. N TYP,NAME,DATE,SET,SET0,SETNM,QO
  1. S TYP=$P($G(^ORD(101.43,DA(1),"LR")),U,7) I (TYP="O")!(TYP="N") D SK3 Q
  1. S NAME=$P(^ORD(101.43,DA(1),0),U),DATE=$G(^(.1)),SET=0 Q:X=NAME
  1. F S SET=$O(^ORD(101.43,DA(1),9,SET)) Q:SET'>0 S SET0=$G(^(SET,0)) D
  1. . S SETNM=$P(SET0,U),QO=$P(SET0,U,2)
  1. . S ^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(X),DA(1))="1^"_X_U_DATE_U_NAME_U_QO
  1. . S ^ORD(101.43,"AH","S."_SETNM)=$H
  1. Q
  1. ;
  1. SK3 ; -- Kill S.SET mnemonic xref from SYN multiple
  1. N SET,SETNM
  1. S SET=0 F S SET=$O(^ORD(101.43,DA(1),9,SET)) Q:SET'>0 S SETNM=$P(^(SET,0),U) D
  1. . I $G(^ORD(101.43,"S."_SETNM,$$UP^XLFSTR(X),DA(1))) K ^(DA(1))
  1. . S ^ORD(101.43,"AH","S."_SETNM)=$H
  1. Q
  1. ;
  1. CS(NAME,CODE,DATE) ; -- Set C.SET xref by 'Code Name', Set
  1. Q:'$L($G(NAME)) Q:'$L($G(CODE))
  1. N X,XP,ORS,SET0,SETNM,QO
  1. S X=CODE_" "_NAME,XP=$$UP^XLFSTR(X)
  1. S ORS=0 F S ORS=$O(^ORD(101.43,DA,9,ORS)) Q:ORS'>0 S SET0=$G(^(ORS,0)) D
  1. . S SETNM=$P(SET0,U),QO=$P(SET0,U,2)
  1. . S ^ORD(101.43,"C."_SETNM,XP,DA)=U_X_U_$G(DATE)_U_U_QO
  1. Q
  1. ;
  1. CK(NAME,CODE) ; -- Kill C.SET xref
  1. Q:'$L($G(NAME)) Q:'$L($G(CODE))
  1. N XP,ORS,ORSET S XP=$$UP^XLFSTR(CODE_" "_NAME)
  1. 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)
  1. Q
  1. ;
  1. QO(X) ; -- Add data to SET xrefs, set/kill AQO xref
  1. N NAME,XREF,SYN,SYNM S X=$G(X)
  1. S NAME=$$UP^XLFSTR($P($G(^ORD(101.43,DA(1),0)),U)),XREF="S."_$P($G(^(9,DA,0)),U)
  1. S:X ^ORD(101.43,DA(1),9,"AQO",XREF)=""
  1. K:'X ^ORD(101.43,DA(1),9,"AQO",XREF)
  1. Q:'$D(^ORD(101.43,XREF,NAME,DA(1))) S $P(^(DA(1)),U,5)=X
  1. 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
  1. S ^ORD(101.43,"AH",XREF)=$H
  1. Q
  1. ;
  1. XHELP(INDEX,SCREEN) ; -- ??Help
  1. N X,Y,Y0,Z,SYN,CNT,D,DONE
  1. S:'$L($G(INDEX)) INDEX="B" W !!,"Choose from:" S CNT=1,D=INDEX
  1. S X="" F S X=$O(^ORD(101.43,INDEX,X)) Q:X="" S Y=0 D Q:$G(DONE)
  1. . F S Y=$O(^ORD(101.43,INDEX,X,Y)) Q:Y'>0 S SYN=$G(^(Y)) I 'SYN D Q:$G(DONE)
  1. . . S Y0=$G(^ORD(101.43,Y,0)) X:$L($G(SCREEN)) SCREEN Q:'$T
  1. . . W !," "_X ;W:SYN " "_$P(SYN,U,4) ; echo .01 if synonym
  1. . . S CNT=CNT+1 Q:CNT'>(IOSL-5) S CNT=0
  1. . . W !," '^' TO STOP: " R Z:DTIME S:'$T!(Z["^") DONE=1
  1. W !
  1. Q
  1. ;
  1. ACTIVE(ITM) ; -- Screen, if inactive or restricted to QO use only
  1. ; Use in DIC("S") when searching #101.43
  1. N Y S Y=1
  1. I $G(ORTYPE)="D",$L($G(D)),$D(^ORD(101.43,+ITM,9,"AQO",$P(D,U))) S Y=0
  1. I $G(^ORD(101.43,+ITM,.1)),^(.1)'>$$NOW^XLFDT S Y=0 ;inactive
  1. Q Y
  1. ;
  1. ID(OLD,NEW) ; -- API for package to update ID field [ code;99XXX ]
  1. ; Returns 1 or 0, if successful or not
  1. N IFN,Y S Y=0
  1. G:'$G(OLD) IDQ G:$G(NEW)'?1.N1";99"3U IDQ ;invalid
  1. S IFN=+$O(^ORD(101.43,"ID",OLD,0)) G:IFN'>0 IDQ
  1. K ^ORD(101.43,"ID",OLD,IFN)
  1. S $P(^ORD(101.43,IFN,0),U,2)=NEW,^ORD(101.43,"ID",NEW,IFN)="",Y=1
  1. IDQ Q Y