| 1 | DGPMV36 ;ALB/MIR - TREATING SPECIALTY TRANSFER, CONTINUED ; SEP 15 1989@12
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | I '$P(DGPMA,"^",9) S DGPMA="",DIK="^DGPM(",DA=DGPMDA D ^DIK K DIK W !,"Incomplete Treating Specialty Transfer...Deleted"
|
|---|
| 5 | Q
|
|---|
| 6 | ;
|
|---|
| 7 | DICS ; -- check that it is a PROVIDER/SPECIALTY change
|
|---|
| 8 | S DGER=DGPMTYP'=20
|
|---|
| 9 | Q
|
|---|
| 10 | ;
|
|---|
| 11 | ONLY ; -- determine if there is only one 'specialty xfr' type mvt
|
|---|
| 12 | N C,I S C=0
|
|---|
| 13 | F I=0:0 S I=$O(^DG(405.1,"AT",6,I)) Q:'I I $D(^DG(405.1,I,0)),$P(^(0),"^",4) S C=C+1,DGPMSPI=I I C>1 K DGPMSPI Q
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | SPEC ; -- entry point to add/edit specialty mvt when adding/editing
|
|---|
| 17 | ; a physical mvt
|
|---|
| 18 | ;
|
|---|
| 19 | ; Input: Y = ifn of mvt file ^ auto add specialty entry(1)
|
|---|
| 20 | ; Output: Y = ifn of spec mvt
|
|---|
| 21 | ;
|
|---|
| 22 | ; Variable: DGPMPHY = physical mvt IFN ; DGPMPHY0 = 0th node
|
|---|
| 23 | ; DGPMSP = specialty mvt IFN
|
|---|
| 24 | ;
|
|---|
| 25 | Q:'$D(^DGPM(+Y,0))
|
|---|
| 26 | N DGPMT,DGPMN S DGPMPHY=+Y,DGPMPHY0=^DGPM(+Y,0),DGPMT=6,DGPMN=0
|
|---|
| 27 | S DGPMSP=$S($D(^DGPM("APHY",DGPMPHY)):$O(^(DGPMPHY,0)),1:"")
|
|---|
| 28 | I 'DGPMSP S Y=+$P(Y,"^",2) D ASK:'Y G SPECQ:'Y D NEW
|
|---|
| 29 | D EDIT:DGPMSP
|
|---|
| 30 | SPECQ S Y=DGPMSP K DGPMPHY,DGPMPHY0,DGPMSP Q
|
|---|
| 31 | ;
|
|---|
| 32 | ASK ; -- ask user if they want to make a special mvt also
|
|---|
| 33 | W ! S DIR(0)="YA",DIR("A")="Do you wish to associate a 'facility treating specialty' transfer? "
|
|---|
| 34 | S DIR("?",1)="If you would like to associate a facility specialty"
|
|---|
| 35 | S DIR("?",2)="transfer with this physical movement than answer 'Yes'."
|
|---|
| 36 | S DIR("?")="Otherwise, answer with a 'No'."
|
|---|
| 37 | D ^DIR K DIR
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | NEW ; -- add a specialty mvt
|
|---|
| 41 | S X=DGPMPHY0,Y=+X_U_DGPMT_U_$P(X,U,3),$P(Y,U,14)=$P(X,U,14),$P(Y,U,24)=DGPMPHY
|
|---|
| 42 | S X=+X,DGPM0ND=Y D NEW^DGPMV3
|
|---|
| 43 | S DGPMSP=$S(+Y>0:+Y,1:"") S DGPMN=(+Y>0)
|
|---|
| 44 | I DGPMSP,$P(DGPMPHY0,"^",2)=1,$P(DGPMPHY0,"^",10)]"" S DR="99///"_$P(DGPMPHY0,"^",10),DA=DGPMSP,DIE="^DGPM(" D ^DIE
|
|---|
| 45 | K DIE,DIC,DA,DR,DGPM0ND
|
|---|
| 46 | Q
|
|---|
| 47 | EDIT ; -- edit specialty mvt
|
|---|
| 48 | N DGPMX,DGPMP
|
|---|
| 49 | I DGPMN S (DGPMP,^UTILITY("DGPM",$J,6,DGPMSP,"P"))="",DIE("NO^")=""
|
|---|
| 50 | I 'DGPMN S (DGPMP,^UTILITY("DGPM",$J,6,DGPMSP,"P"))=^DGPM(DGPMSP,0)
|
|---|
| 51 | S Y=DGPMSP D PRIOR
|
|---|
| 52 | S DGPMN=(+DGPMP=+DGPMPHY0) ;set to 1 no dt/time change to bypass x-refs
|
|---|
| 53 | S DGPMX=+DGPMPHY0,DA=DGPMSP,DIE="^DGPM(",DR="[DGPM SPECIALTY TRANSFER]"
|
|---|
| 54 | K DQ,DG D ^DIE
|
|---|
| 55 | S ^UTILITY("DGPM",$J,6,DGPMSP,"A")=$S($D(^DGPM(DGPMSP,0)):^(0),1:"")
|
|---|
| 56 | S Y=DGPMSP D AFTER
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | PRIOR ; -- set special 'prior' nodes for event driver
|
|---|
| 60 | I DGPMN S (^UTILITY("DGPM",$J,6,Y,"DXP"),^("PTFP"))=""
|
|---|
| 61 | I 'DGPMN S X=$P($S($D(^DGPM(Y,"DX",0)):^(0),1:""),"^",3,4),X=X_$S($D(^(1,0)):$E(^(0),1,245-$L(X)),1:""),^UTILITY("DGPM",$J,6,Y,"DXP")=X,^UTILITY("DGPM",$J,6,Y,"PTFP")=$S($D(^DGPM(Y,"PTF")):^("PTF"),1:"")
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | AFTER ; -- set special 'after' nodes for event driver
|
|---|
| 65 | S X=$P($S($D(^DGPM(Y,"DX",0)):^(0),1:""),"^",3,4),X=X_$S($D(^(1,0)):$E(^(0),1,245-$L(X)),1:""),^UTILITY("DGPM",$J,6,Y,"DXA")=X,^UTILITY("DGPM",$J,6,Y,"PTFA")=$S($D(^DGPM(Y,"PTF")):^("PTF"),1:"")
|
|---|
| 66 | Q
|
|---|
