- PXRMLLED ; SLC/PJH - Edit a location list. ;06/09/2009
- ;;2.0;CLINICAL REMINDERS;**4,6,11,12**;Feb 04, 2005;Build 73
- ;
- ;================================================================
- N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,FILEA,IENA,NUM,Y
- GETNAME ;Get the name of the location list to edit.
- K DA,DIC,DLAYGO,DTOUT,DUOUT,Y
- S DIC="^PXRMD(810.9,"
- S DIC(0)="AEMQL"
- S DIC("A")="Select Location List: "
- S DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
- S DLAYGO=810.9
- ;Set the starting place for additions.
- D SETSTART^PXRMCOPY(DIC)
- W !
- D ^DIC
- I ($D(DTOUT))!($D(DUOUT)) Q
- I Y=-1 G END
- S DA=$P(Y,U,1)
- S CS1=$$FILE^PXRMEXCS(810.9,DA)
- D EDIT(DIC,DA)
- ;See if any changes have been made, if so do the edit history.
- S CS2=$$FILE^PXRMEXCS(810.9,DA)
- I CS2'=0,CS2'=CS1 D SEHIST^PXRMUTIL(810.9,DIC,DA)
- G GETNAME
- END ;
- Q
- ;
- ;================================================================
- EDIT(ROOT,DA) ;
- N DIE,DR,DIDEL,RESULT,X,Y
- S DIE=ROOT,DIDEL=810.9
- NAME S DR=".01"
- D ^DIE
- I '$D(DA) Q
- I $D(Y) Q
- CLASS ;
- ;Class
- RETRY W !!
- S DR="100"
- D ^DIE
- I $D(Y) G NAME
- ;Sponsor
- S DR="101"
- D ^DIE
- I $D(Y) G RETRY
- ;Make sure Class and Sponsor Class are in synch.
- S RESULT=$$VSPONSOR^PXRMINTR(X)
- I RESULT=0 S DIE("NO^")="Other value" G RETRY
- I RESULT=1 K DIE("NO^")
- ;Review date
- RD W !!
- S DR="102"
- D ^DIE
- I $D(Y) G RETRY
- ;
- ;Description
- DES S DR="1"
- D ^DIE
- I $D(Y) G RD
- ;
- ;Clinic Stops
- CS S DR="40.7"
- S DR(2,810.9001)=".01;1;2;3"
- S DR(3,810.90011)=".01"
- D ^DIE
- I $D(Y) G RD
- ;
- ;Hospital Locations
- HL S DR="44"
- D ^DIE
- I $D(Y) G CS
- Q
- ;
- ;================================================================
- KAMIS(X,DA,WHICH) ;Kill the AMIS Reporting Stop Code.
- ;Do not execute as part of a verify fields.
- I $G(DIUTIL)="VERIFY FIELDS" Q
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q
- I WHICH="CREDIT STOP TO EXCLUDE" S $P(^PXRMD(810.9,DA(2),40.7,DA(1),1,DA,0),U,2)=""
- E S $P(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=""
- Q
- ;
- ;================================================================
- SAMIS(X,DA,WHICH) ;Set the AMIS Reporting Stop Code.
- ;Do not execute as part of a verify fields.
- I $G(DIUTIL)="VERIFY FIELDS" Q
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q
- N AMIS
- ;DBIA #557
- S AMIS=$P(^DIC(40.7,X,0),U,2)
- I WHICH="CREDIT STOP TO EXCLUDE" S $P(^PXRMD(810.9,DA(2),40.7,DA(1),1,DA,0),U,2)=AMIS
- E S $P(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=AMIS
- Q
- ;
- PXRMLLED ; SLC/PJH - Edit a location list. ;06/09/2009
- +1 ;;2.0;CLINICAL REMINDERS;**4,6,11,12**;Feb 04, 2005;Build 73
- +2 ;
- +3 ;================================================================
- +4 NEW CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,FILEA,IENA,NUM,Y
- GETNAME ;Get the name of the location list to edit.
- +1 KILL DA,DIC,DLAYGO,DTOUT,DUOUT,Y
- +2 SET DIC="^PXRMD(810.9,"
- +3 SET DIC(0)="AEMQL"
- +4 SET DIC("A")="Select Location List: "
- +5 SET DIC("S")="I $$VEDIT^PXRMUTIL(DIC,Y)"
- +6 SET DLAYGO=810.9
- +7 ;Set the starting place for additions.
- +8 DO SETSTART^PXRMCOPY(DIC)
- +9 WRITE !
- +10 DO ^DIC
- +11 IF ($DATA(DTOUT))!($DATA(DUOUT))
- QUIT
- +12 IF Y=-1
- GOTO END
- +13 SET DA=$PIECE(Y,U,1)
- +14 SET CS1=$$FILE^PXRMEXCS(810.9,DA)
- +15 DO EDIT(DIC,DA)
- +16 ;See if any changes have been made, if so do the edit history.
- +17 SET CS2=$$FILE^PXRMEXCS(810.9,DA)
- +18 IF CS2'=0
- IF CS2'=CS1
- DO SEHIST^PXRMUTIL(810.9,DIC,DA)
- +19 GOTO GETNAME
- END ;
- +1 QUIT
- +2 ;
- +3 ;================================================================
- EDIT(ROOT,DA) ;
- +1 NEW DIE,DR,DIDEL,RESULT,X,Y
- +2 SET DIE=ROOT
- SET DIDEL=810.9
- NAME SET DR=".01"
- +1 DO ^DIE
- +2 IF '$DATA(DA)
- QUIT
- +3 IF $DATA(Y)
- QUIT
- CLASS ;
- +1 ;Class
- RETRY WRITE !!
- +1 SET DR="100"
- +2 DO ^DIE
- +3 IF $DATA(Y)
- GOTO NAME
- +4 ;Sponsor
- +5 SET DR="101"
- +6 DO ^DIE
- +7 IF $DATA(Y)
- GOTO RETRY
- +8 ;Make sure Class and Sponsor Class are in synch.
- +9 SET RESULT=$$VSPONSOR^PXRMINTR(X)
- +10 IF RESULT=0
- SET DIE("NO^")="Other value"
- GOTO RETRY
- +11 IF RESULT=1
- KILL DIE("NO^")
- +12 ;Review date
- RD WRITE !!
- +1 SET DR="102"
- +2 DO ^DIE
- +3 IF $DATA(Y)
- GOTO RETRY
- +4 ;
- +5 ;Description
- DES SET DR="1"
- +1 DO ^DIE
- +2 IF $DATA(Y)
- GOTO RD
- +3 ;
- +4 ;Clinic Stops
- CS SET DR="40.7"
- +1 SET DR(2,810.9001)=".01;1;2;3"
- +2 SET DR(3,810.90011)=".01"
- +3 DO ^DIE
- +4 IF $DATA(Y)
- GOTO RD
- +5 ;
- +6 ;Hospital Locations
- HL SET DR="44"
- +1 DO ^DIE
- +2 IF $DATA(Y)
- GOTO CS
- +3 QUIT
- +4 ;
- +5 ;================================================================
- KAMIS(X,DA,WHICH) ;Kill the AMIS Reporting Stop Code.
- +1 ;Do not execute as part of a verify fields.
- +2 IF $GET(DIUTIL)="VERIFY FIELDS"
- QUIT
- +3 ;Do not execute as part of exchange.
- +4 IF $GET(PXRMEXCH)
- QUIT
- +5 IF WHICH="CREDIT STOP TO EXCLUDE"
- SET $PIECE(^PXRMD(810.9,DA(2),40.7,DA(1),1,DA,0),U,2)=""
- +6 IF '$TEST
- SET $PIECE(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=""
- +7 QUIT
- +8 ;
- +9 ;================================================================
- SAMIS(X,DA,WHICH) ;Set the AMIS Reporting Stop Code.
- +1 ;Do not execute as part of a verify fields.
- +2 IF $GET(DIUTIL)="VERIFY FIELDS"
- QUIT
- +3 ;Do not execute as part of exchange.
- +4 IF $GET(PXRMEXCH)
- QUIT
- +5 NEW AMIS
- +6 ;DBIA #557
- +7 SET AMIS=$PIECE(^DIC(40.7,X,0),U,2)
- +8 IF WHICH="CREDIT STOP TO EXCLUDE"
- SET $PIECE(^PXRMD(810.9,DA(2),40.7,DA(1),1,DA,0),U,2)=AMIS
- +9 IF '$TEST
- SET $PIECE(^PXRMD(810.9,DA(1),40.7,DA,0),U,2)=AMIS
- +10 QUIT
- +11 ;
